Dein Script ist nicht lauffähig.
- Schreibe immer in die erste Zeile eines Moduls Option Explizit. Dadurch wirst du gezwungen Variablen zu deklarieren. Das bewahrt dich vor schwer zu findenden Tippfehlern.
- Deine Variable lngLetzte1 hat keine Typzuweisung, womit sie automatisch vom Datentyp Variant deklariert wird. Vermeide die Deklaration mehrerer Variablen in einer Zeile. Du sparst dadurch nur ein paar Dim und verlierst viel Übersicht. Also jede Deklaration auf eine Zeile.
- Jede With Anweisung muss mit End With geschlossen werden. Bei dir fehlt End With 2x.
- Es heißt nicht Workbook(Name) sondern Workbooks(Name).
- Objekte werden mit einem Punkt getrennt und nicht wie ein Dateipfad aufgebaut
Weiter habe den Code nicht analysiert, aber gelaufen ist der mit Sicherheit nie ;-)
Option Explicit
Sub test()
'Suche nach Teilstring
Dim rFinde1 As Range
Dim rSuche1 As Range
Dim strFirst1 As String
Dim lngReihe1 As Long
Dim lngLetzte1 As Long 'War ohne Typ deklariert, was dann automatisch Variant ist
Dim lngLetzte2 As Long
Dim I1 As Integer
Dim QName As String 'War nicht deklariert
Dim Ort31 As String 'War nicht deklariert
Dim Suchliste As String 'War nicht deklariert
Dim Suchsheet As String 'War nicht deklariert
'Name des ZielWorkbook aus dem die Werte zum Suchen kommen (In meinem Text ZWB)
With Workbooks(QName)
'Name des ZielWorksheet (Zielsheet)
With Sheets(Ort31)
'letzte volle Zeile in Sheet Zielsheet ermitteln, da stehen die Suchwerte in den Spalten von Spalte B
lngLetzte1 = IIf(IsEmpty(.Cells(Rows.Count, 2)), .Cells(Rows.Count, 2).End(xlUp).Row, Rows.Count)
End With
End With 'fehlte
'QuellWorkbook mit allen EQ (QWB)
With Workbooks(Suchliste)
'(Quellsheet)mit allen EQ
With Sheets(Suchsheet)
'letzte volle Zeile in Sheet Quellsheet ermitteln, da stehen die Suchwerte in den Spalten von Spalte A
lngLetzte2 = IIf(IsEmpty(.Cells(Rows.Count, 1)), .Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)
End With
'In Spalte A Sheet Suchsheet soll gesucht werden, da stehen die zu vergleichenden Werte
Set rFinde1 = Sheets(Suchliste & Suchsheet).Range("A2:A" & lngLetzte2)
'With Sheets(QName & "\" & Ort31) 'Das ist falsch. Du hast hier Objekte, keinen Dateipfad
With Workbooks(QName).Sheets(Ort31) 'Objekte werden mit dem Punktoperator getrennt
'Suchschleife, da ja mehr als nur ein Suchwert
For I1 = 1 To lngLetzte1
'.cells.. ist der jeweilige Suchwert
Set rSuche1 = rFinde1.Find(what:=.Cells(I1, 2), lookat:=xlWhole)
'wenn, was gefunden wurde
If Not rSuche1 Is Nothing Then
'merke dir die erste gefundene Zelle (weil können ja mehr sein)
strFirst1 = rSuche1.Address
'weiter Schleife, um die anderen gleichen zu finden
Do
'wir merken uns die Zeile wo in Ort31 der Suchstring steht
lngReihe1 = rSuche1.Row
'Ich glaube das ist der Richtige String
Sheets(Ort31).Range("A" & lngReihe1) = "Aktiv"
' Der hier ist die Alternative, falls der oben nicht richtig ist.
'Sheets(ort31).Range("A" & I1) = "Aktiv"
' wir suchen den nächsten, gleichen Suchstring
Set rSuche1 = rFinde1.FindNext(rSuche1)
'das tun wir solange, bis wir wieder bei der ersten Adresse sind und somit alle gefunden wurden.
Loop While Not rSuche1 Is Nothing And rSuche1.Address <> strFirst1
End If
Next I1
End With
End With 'fehlte
End Sub
|