Hallo
Ich habe einen Suchlauf, mit dem ich eine Zeile einfärbe.
Zur Info, Da ich diesen Suchlauf mit verschiedenen Variablen mehrmals verwende, setze ich bei den Variablen eine Zahl (in diesem Fall 2 )ein.
Z.B.: rFinde2
Nun Möchte ich wenn möglich diesen Suchlauf auch dazu verwenden, um aus dem Sheet "Wichtige Meldungen Prio 1", den Wert aus der entsprechenden Zelle "C" & Suchzeile in das Sheet Ort2 in die Zelle "H" & gefundene Zeile zu kopieren. Und das gleiche mit der Zelle "G" & Suchzeile in Zell "I" & gefundene Zeile.
'Suche nach Teilstring (2)
Dim rFinde2 As Range, rSuche2 As Range ' das ist mal eine einfache Variablendeklaration
Dim strFirst2 As String
Dim lngReihe2 As Long, lngLetzte2 As Long
Dim I2 As Integer
With Sheets("Wichtige Meldungen Prio 1")
lngLetzte2 = IIf(IsEmpty(.Cells(Rows.Count, 2)), .Cells(Rows.Count, 2).End(xlUp).Row, Rows. _
_
Count) ' letzte volle Zeile in Sheet "Suchmeldungen" ermitteln, da stehen die Suchwerte in den Spalten von Spalte B
End With
Set rFinde2 = Sheets(Ort2).Range("E:E") ' wo soll gesucht werden, naja, in Spalte E Sheet Ort2, da stehen die zu vergleichenden Werte
With Sheets("Wichtige Meldungen Prio 1")
For I2 = 1 To lngLetzte2 ' Suchschleife, da ja mehr als nur ein Suchwert
Set rSuche2 = rFinde2.Find(what:=.Cells(I2, 2), LookAt:=xlWhole) ' .cells.. ist der jeweilige Suchwert
If Not rSuche2 Is Nothing Then ' wenn, was gefunden wurde
strFirst2 = rSuche2.Address ' merke dir die erste gefundene Zelle (weil k?nnen ja mehr sein)
Do ' weiter Schleife, um die anderen gleichen zu finden
lngReihe2 = rSuche2.Row ' wir merken uns die Zeile wo in Ort2 der Suchstring steht
Sheets(Ort2).Range("A" & lngReihe2).EntireRow.Interior.ColorIndex = 40 ' wir f?rben diese Zeile komplett Rosa ein
Set rSuche2 = rFinde2.FindNext(rSuche2) ' wir suchen den n?chsten, gleichen Suchstring
Loop While Not rSuche2 Is Nothing And rSuche2.Address <> strFirst2 'das tun wir solange, bis wir wieder bei der ersten Adresse sind und somit alle gefunden wurden.
End If
Next I2
End With
Ich denke, das der Code dort wo ich jetzt die Lücke gemacht habe erweitert werden muss.
Ich danke euch
Bernd
|