|
Hi,
Mal angenommen deine Tabelle sieht so aus:
|
Packet 1 |
|
|
|
Packet 2 |
|
|
|
Packet 3 |
|
|
|
|
|
|
|
Suchwert |
23 |
|
|
|
ID |
Packetnummer |
|
|
23 |
1 |
|
|
23 |
2 |
|
|
23 |
3 |
(Die Zellen neben Packet X müssen entsprechend gefärbt sein.)
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B5")) Is Nothing Then Exit Sub
Dim rngSuchen As Range
Dim V, R&, C%, Found&, SS$
SS = CStr(Target.Value)
Set rngSuchen = Range("B6:H500")
With rngSuchen
V = .Value
.Interior.ColorIndex = xlNone
End With
For R = 1 To UBound(V)
For C = 1 To UBound(V, 2)
If CStr(V(R, C)) = SS Then
Select Case CInt(V(R, C + 1))
Case 1
rngSuchen(R, C).Interior.ColorIndex = Cells(1, 2).Interior.ColorIndex
Case 2
rngSuchen(R, C).Interior.ColorIndex = Cells(2, 2).Interior.ColorIndex
Case 3
rngSuchen(R, C).Interior.ColorIndex = Cells(3, 2).Interior.ColorIndex
End Select
Found = Found + 1
End If
Next
Next
If Found = 0 Then
MsgBox ("Nichts gefunden")
Else
MsgBox Found & " Einträg" & IIf(Found > 1, "e", "") & " gefunden."
End If
Target.Select
End Sub
Eventuell ist es das was du machen willst, falls nicht solltest du einfach mal deine aktuelle Tabelle (in lesbarer Form) und das erwünschte Resultat (z.B. in Tabellenform) posten.
Gruß
Till
|