VBA: Vergleich und Texteil suchen - Zeile kopieren

Forumthread: VBA: Vergleich und Texteil suchen - Zeile kopieren

Joe

Hallo liebe Experten,
ich bräuchte mal wieder etwas Hilfe von euch.
Folgende Ausgangssituation:
Es gibt eine Adressliste. In dieser Adressliste stehen in Spalte H Nummern (es können pro Adresse mehrere Nummer in einer Zelle vorkommen - ich weiß, dass ist nicht optimal, es geht leider nicht anderst)
Im zweiten Sheet steht in B3 die zu suchende Nummer.
Beim Start des Makros soll nun die Spalte H nach der Nummer durchsucht werden. Ist eine Zelle gefunden, soll die jeweilige Zeile von Spalte B-G in das zweite Sheet (ab A7) eingefügt werden (Jeder weitere gefundene Datensatz soll dann natürlich darunter eingefügt werden)
Soweit so gut.
Das ganze wird nun durch einen Vergleich etwas erschwert.
Und zwar: Ist der gefundene Datensatz bereit im zweiten Sheet vorhanden soll dieser nicht nochmals kopiert werden.
Für ein besseres Verständnis hier eine Bsp-Datei (die aufgeführten Adressen sind frei erfunden! =) ):
https://www.herber.de/bbs/user/68977.xls
Könnt ihr mir hierbei behilflich sein?
Besten Dank schon mal.
Gruß
Joe

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Spezialfilter ohne Duplikate

08.04.2010 18:18:00

Tino

Hallo,
ich habe es so verstanden und mache es mit dem Spezialfilter ohne Duplikate.
https://www.herber.de/bbs/user/68979.xls
Gruß Tino

AW: VBA: Vergleich und Texteil suchen - Zeile kopieren

09.04.2010 09:59:05

Joe

Hallo Tino,
erst einmal recht herzlichen Dank für deine Lösung.
Sie funktioniert wunderbar.
Allerdings habe ich dennoch ein weiteres Problem, bei dem ich nicht weiterkomme.
In dem zweiten Sheet (in welches die Daten rüber kopiert werden) können jeder Adresse weitere Daten hinzugefügt werden. Zudem werden die Einträge alphabetisch sortiert.
Kommt nun in der Adressliste (Sheet 1) eine neue Adresse mit der zu suchenden Nummer vor, und ich lasse das Makro erneut ablaufen, dann ist meine Sortierung dahin und somit auch die zugeordneten Daten.
Ich möchte also hinbekommen, dass nur eine neue Adresse in das zweit Sheet kopiert (in die erste freie Zeile) wird - alle bereits vorhanden sollen nicht nochmals rüberkopiert werden
Wie lässt sich das am besten lösen?
Gruß und nochmals besten Dank
Joe

AW: VBA: Vergleich und Texteil suchen - Zeile kopieren

09.04.2010 15:10:32

fcs

Hallo Joe,
da sich die Nummern z.T. nur um einen zusätzlichen Buchstaben unterscheiden ist es etwas komplizierter und die Such-Funktion alleine reichte nicht.
Gruß
Franz

Sub NummerSuchen()
Dim vNummer As Variant, arrNummern, iI As Integer
Dim ZelleAdr As Range, ZeileFZ As Long, ZeileAdr As Long
Dim SpalteAdr As Long, SpalteFZ As Long
Dim Adresse1 As String, bVorhanden As Boolean, bIdentisch As Boolean
Dim wksAdr As Worksheet, wksFZ As Worksheet
Set wksFZ = Worksheets("Freizeit")
Set wksAdr = Worksheets("Adressen")
vNummer = wksFZ.Range("B3").Value
Set ZelleAdr = wksAdr.Columns(8).Find(what:=vNummer, LookIn:=xlValues, lookat:=xlPart)
If ZelleAdr Is Nothing Then
MsgBox "Keine Adressen zu Nummer gefunden"
Else
ZeileFZ = wksFZ.Cells(wksFZ.Rows.Count, 2).End(xlUp).Row
Adresse1 = ZelleAdr.Address
Do
ZeileAdr = ZelleAdr.Row
bVorhanden = False
'exakte Übereinstimmung der Nummern prüfen
arrNummern = Split(ZelleAdr.Value, ",")
bIdentisch = False
For iI = LBound(arrNummern) To UBound(arrNummern)
If vNummer = Trim(arrNummern(iI)) Then
bIdentisch = True
Exit For
End If
Next
If bIdentisch = True Then
If ZeileFZ = 6 Then
'noch kein Eintrag in Blatt Freizeit vorhanden
Else
'Prüfen, ob Eintrag schon vorhanden - alle 6 spalten der Zeilen identisch
For ZeileFZ = 7 To wksFZ.Cells(wksFZ.Rows.Count, 2).End(xlUp).Row
SpalteAdr = 1
bIdentisch = True
For SpalteFZ = 1 To 6
SpalteAdr = SpalteAdr + 1
If wksFZ.Cells(ZeileFZ, SpalteFZ)  wksAdr.Cells(ZeileAdr, SpalteAdr) Then
bIdentisch = False
Exit For
End If
Next
If bIdentisch = True Then
bVorhanden = True
Exit For
End If
Next
End If
If bVorhanden = False Then
ZeileFZ = wksFZ.Cells(wksFZ.Rows.Count, 2).End(xlUp).Row + 1
SpalteAdr = 1
For SpalteFZ = 1 To 6
SpalteAdr = SpalteAdr + 1
wksFZ.Cells(ZeileFZ, SpalteFZ) = wksAdr.Cells(ZeileAdr, SpalteAdr)
Next
End If
End If
Set ZelleAdr = wksAdr.Columns(8).FindNext(after:=ZelleAdr)
Loop Until ZelleAdr.Address = Adresse1
End If
End Sub

AW: VBA: Vergleich und Texteil suchen - Zeile kopieren

10.04.2010 11:34:44

Joe

Hallo Franz,
vielen Dank für deine Lösung. Werde versuchen diese mal zu verstehen... =)
Gruß
Joe

Beliebteste Forumthreads (12 Monate)

VBA: Vergleich und Texteil suchen - Zeile kopieren

Forumthread: VBA: Vergleich und Texteil suchen - Zeile kopieren

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

VBA: Vergleich und Texteil suchen - Zeile kopieren

Forumthread: VBA: Vergleich und Texteil suchen - Zeile kopieren

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread