Moro,
Vähän on mennyt ruosteeseen excelin hallinta, koska viime kerrasta on aikaa. Ja vähän olisi pulman poikasta mikä pitäisi koittaa ratkaista. Tiedä sitten onko etes tuollainen mahdollista excelissä.
Mutta asiaan:
Minulla on yhdessä taulukon välilehdessä 3 sarakkeessa tietoja. Tuosta A sarakkeesta täytyisi sitten vertailla tietoja. Joudun käymään tavaroita läpi ja niissä on tietty viivakoodi joka viittaa tuohon A sarakkeen tietoihin. Kun ampuisin tuon viivakoodin johonkin soluun niin tarkoitus olisi, että jos tuo sama tieto löytyisi A sarakkeesta se värjäytyisi vihreäksi ja kopioisi sitten sen koko rivin toiselle välilehdelle.
Ei kuulosta kovin vaikealta, mutta ei vaan jostain syystä selviä nyt itselle miksi ei onnistu. Vai onkohan etes tuollainen mahdollista toteuttaa suoraan excelissä?
-Jukka
Vähän on mennyt ruosteeseen excelin hallinta, koska viime kerrasta on aikaa. Ja vähän olisi pulman poikasta mikä pitäisi koittaa ratkaista. Tiedä sitten onko etes tuollainen mahdollista excelissä.
Mutta asiaan:
Minulla on yhdessä taulukon välilehdessä 3 sarakkeessa tietoja. Tuosta A sarakkeesta täytyisi sitten vertailla tietoja. Joudun käymään tavaroita läpi ja niissä on tietty viivakoodi joka viittaa tuohon A sarakkeen tietoihin. Kun ampuisin tuon viivakoodin johonkin soluun niin tarkoitus olisi, että jos tuo sama tieto löytyisi A sarakkeesta se värjäytyisi vihreäksi ja kopioisi sitten sen koko rivin toiselle välilehdelle.
Ei kuulosta kovin vaikealta, mutta ei vaan jostain syystä selviä nyt itselle miksi ei onnistu. Vai onkohan etes tuollainen mahdollista toteuttaa suoraan excelissä?
-Jukka
Vastaukset 2
Vanhimmat
Tuon välilehden moduliin seuraavat:
Sub talleta(r As Integer)
With Worksheets("Sheet2") ' toinen välilehti
v = .UsedRange.Rows.Count 1
.Cells(v, 1) = Cells(r, 1)
.Cells(v, 2) = Cells(r, 2)
.Cells(v, 3) = Cells(r, 3)
End With
Range(Cells(r, 1), Cells(r, 3)).Interior.Color = RGB(0, 255, 0)
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Set haettava = Range("B1") ' viivakoodi syötetään tähän soluun
If Not Intersect(Target, haettava) Is Nothing Then
r = 4 ' ensimmäinen tietorivi
Do
If Cells(r, 1).Text = haettava.Text Then
If Cells(r, 1).Interior.Color = RGB(0, 255, 0) Then Exit Sub ' jo talletettu
If MsgBox(Cells(r, 1).Text & vbCrLf & Cells(r, 2).Text & _
vbCrLf & Cells(r, 3).Text & vbCrLf & vbCrLf & "OK?", _
vbYesNo, "Löytyi:") = vbYes Then talleta (r)
Exit Sub
ElseIf Cells(r, 1).Text = "" Then
Exit Sub
End If
r = r 1
Loop
End If
End Sub
Todella hieno koodin pätkä. Juurikin tuollaista hain. Todella paljon kiitosta. Nyt homma onnistuu paljon joutusammin
-Jukka