VBA: If-Fkt mit Teilstring - Daten aktualisieren
Joe
ich stehe mal wieder vor einer Hürde, bei der ich eure Hilfe bräuchte.
Folgender Code sucht in einer Adressdatei (adressen.xls) nach einer Nummer (Spalte Q). Diese Nummer steht in einer Zelle in welcher noch weitere, durch Komme getrennte, Nummern stehen können.
Hat er eine Nummer gefunden wird überprüft ob diese Adresse in einer zweiten Datei vorhanden ist (Suchkriterium ist ein Primärschlüssel, welche jede Adresse besitzt - befindet sich in Spalte A). Ist in der zweiten Datei dieser Primärschlüssel (auch Spalte A) noch nicht vorhanden wird der Datensatz in die nächste leere Zeile geschrieben.
Jetzt kommt das Problem:
Eigentlich sollte der Code, wenn er in der zweiten Datei den Primärschlüssel (und somit auch eine Adresse) gefunden hat für diese Adresse die Spalten 2-18 auf den Stand der Adressdatei aktualisieren. Dies tut er leider nicht...
Ich wäre euch für eure Hilfe sehr dankbar.
Anbei der Code und eine Bsp.Datei:
In der Bsp.Datei kann die o.g. zweite Datei über den Button "Freizeitliste erstellen" erzeugt werden. Über den Button "Liste aktualisieren" können Daten in die zweite Datei eingefügt werden (mit genanntem Code)
Bsp.Datei: https://www.herber.de/bbs/user/71217.xls
Code (Der Code stammt von Erich G. aus diesem Forum - Herzlichen Dank):
Sub Teilnehmer_einfuegen()
'Definition der Variablen
Dim wsAd As Worksheet, lngAd As Long, zA As Long
Dim wsFz As Worksheet, lngFz As Long, zF As Long
Dim rngF As Range, lngZ As Long
Set wsFz = ThisWorkbook.Worksheets("Teilnehmerliste")
lngFz = wsFz.Cells(wsFz.Rows.Count, 1).End(xlUp).Row + 1
Workbooks("Adr.GWBB.xls").Activate
Set wsAd = ActiveWorkbook.Worksheets("AdrGWBB")
With wsAd
.Activate
lngAd = .Cells(.Rows.Count, 1).End(xlUp).Row
For zA = 2 To lngAd
If .Cells(zA, 17) Like "*" & wsFz.Cells(2, 8) & "*" Then
Set rngF = wsFz.Range("A17:A" & lngFz).Find(.Cells(zA, 1), _
LookIn:=xlValues, LookAt:=xlWhole)
If rngF Is Nothing Then
lngZ = lngFz: lngFz = lngFz + 1
Else
lngZ = rngF.Row
End If
wsFz.Cells(lngZ, 1).Resize(, 18) = .Cells(zA, 1).Resize(, 18).Value
End If
Next zA
End With
End Sub