VBA If-Fkt mit Teilstring
Jonathan
ich bekomme es einfach nicht hin...
Ausgangssituation:
2 Dateien mit Adressdaten (1 Zeile A-H) enstpricht einer Adresse.
Jede Adresse hat in Spalte A eine Adressnummer, quasi als Primärschlüssel
Folgender Code vergleicht die Datei "Freizeitliste_XY500.xls" mit der Datei "Adressdaten.xls"
Dabei wird untersucht ob in "Freizeitliste_XY500.xls" die Adressnummer aus "Adressdaten.xls" vorhanden ist.
Ist dies der Fall werden die Spalten B-H in "Freizeitliste_XY500.xls" aktualisiert (Daten kommen aus "Adressdaten.xls")
Ist dies nicht der Fall wird, also "Adressdaten.xls" enthält eine oder mehrere Adressnummern welche nicht in "Freizeitliste_XY500.xls" enthalten so werden die neuen Adressen in die nächste freie Zeile eingefügt.
Dies funktioniert bislang wuderbar!
Allerdings soll nun noch ein weiteres Suchkriterium eingebaut werden.
Beim Vergleich sollen nur Adressen berücksichtig werden, welche in Spalte H "XY500" enthalten.
Allerdings können in Spalte H mehrere Werte, durch Komma getrennt stehen.
Vielen Dank schon mal für eure Hilfe!
Hier noch die Beispieldateien sowie der bisherige Code:
Adressdaten: https://www.herber.de/bbs/user/69567.xls
Freizeitliste: https://www.herber.de/bbs/user/69568.xls
Code (in Freizeitliste) :
Sub Datenkopieren()
Dim wkb1 As Workbook
Dim wkb As Workbook
Dim wks1 As Worksheet
Dim wks As Worksheet
On Error Resume Next
On Error GoTo 0
Set wkb = Workbooks("Freizeitliste_XY500.xls")
Set wkb1 = Workbooks("Adressdaten.xls")
wkb1.Activate
Set wks = wkb.Worksheets("Freizeitliste (VORLAGE)")
Set wks1 = wkb1.Worksheets("Adressen")
anz = wks.Cells(65536, 1).End(xlUp).Row
anz1 = wks1.Cells(65536, 1).End(xlUp).Row
For x = 11 To anz1
suchwert = wks1.Cells(x, 1)
With wks.Range("A17:A" & anz)
Set c = .Find(suchwert, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
For s = 2 To 8
wks.Cells(c.Row, s) = wks1.Cells(x, s)
Next
Else
For s = 1 To 8
wks.Cells(anz + 1, s) = wks1.Cells(x, s)
Next
anz = Cells(65536, 1).End(xlUp).Row
End If
End With
Next
End Sub