Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA: If-Fkt mit Teilstring - Daten aktualisieren

VBA: If-Fkt mit Teilstring - Daten aktualisieren
Joe
Hallo liebe Experten,
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

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: VBA: If-Fkt mit Teilstring - Daten aktualisieren
24.08.2010 13:10:36
fcs
Hallo Joe,
hier die Prozedur "Teilnehmer_einfuegen" aus deiner Datei. Es fehlte ein ".Row". Sie passt aber bezüglich der verwendeten Dateinamen nicht zu der von dir in der Frage geposteten Prozedur und enthält auch jede Menge Kommentare.
Speichert man deine hochgeladenen Datei unter dem Namen "Adressen.xls" dann funktioniert nach der kleinen Korrektur im Code das Erstellen der Teilnehmerliste und auch ggf. die Aktualisierung.
Gruß
Franz
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
'Zuweisung der Variablen
Set wsFz = ThisWorkbook.Worksheets("Teilnehmerliste") '++++ Bei Änderung des Blattnamens, _
bitte hier Namen anpassen!
lngFz = wsFz.Cells(wsFz.Rows.Count, 1).End(xlUp).Row + 1
'    ChDir "C:\Users\Jonathan\Desktop"
'    Workbooks.Open Filename:="C:\Users\Jonathan\Desktop\Adr.GWBB.xls"
Workbooks("adressen.xls").Activate '++++ Bei Änderung des Dateinamens der _
Adressdaten, bitte hier Dateinamen anpassen!
Set wsAd = ActiveWorkbook.Worksheets("Adressen") '++++ Bei Änderung des Blattnamen in _
der Datei Adressdaten, bitte hier Namen anpassen!
With wsAd
.Activate
lngAd = .Cells(.Rows.Count, 1).End(xlUp).Row
For zA = 2 To lngAd '#### ggf. Zeilennr. anpassen (2) - ab hier fangen in der _
Adressdatei die Namen an                   ->          ->          ->
If .Cells(zA, 17) Like "*" & wsFz.Cells(2, 8) & "*" Then '#### (zA, 17) -> _
ggf. Spalte (17 entspr. P) anpassen - hier stehen die Freizeitnummern _
in der Adressdatei.   wsFz.Cells(2, 8) -> entspricht Zelle H2 in der _
Teilnehmerliste. Ggf. anpassen - hier steht die zu suchende Freizeitnummer.
Set rngF = wsFz.Range("A17:A" & lngFz).Find(.Cells(zA, 1), _
LookIn:=xlValues, LookAt:=xlWhole) '#### wsFz.Range("A17:A" & _
lngFz).Find(.Cells(zA, 1) -> Die Teilnehmerliste wird ab Zelle A17 bis _
zum letzten Eintrag in Spalte A mit der Spalte A der Adressdatei verglichen.  _
_
Teilnehmerdaten werden aktualisiert, neue Teilnehmer werden hinzugefügt, _
abgemeldetete Teilnehmer werden entfernt
If rngF Is Nothing Then
lngZ = lngFz:    lngFz = lngFz + 1
ElseIf Not rngF Is Nothing Then
               '#####   Hier fehlte ".Row" in der nächsten Zeile    ######
lngZ = rngF.Row ':     lngFz = lngFz
End If
wsFz.Cells(lngZ, 1).Resize(, 18) = .Cells(zA, 1).Resize(, 18).Value
End If
Next zA
End With
End Sub

Anzeige

332 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige