Find Funktion in VBA

Hallo zusammen,
ich habe eine Frage zur Find Funktion in einer ziemlich großen Datei. Ich habe zwei Tabellenblätter. In Tabelle2 habe ich in Saplte A eine Liste mit ca. 20000 numerischen Einträgen. In Spalte B,C,D sind zu einigen dieser Einträge entsprechende Werte zugehörig. Die Werte aus Spalte A möchte ich nun einzeln durchgehen und jeden in Tabelle1, Spalte A suchen. Wenn es den Wert gibt, sollen die zugehörigen Werte aus Spalte B,C,D auch in Tabelle1 hinzugefügt werden.
In der Beispielmappe habe ich mit der Find Funktion versucht ie Aufgabe zu lösen, aber natürlich klappt es nicht:-)
https://www.herber.de/bbs/user/75369.xls
Ich weiß, der Code ist ziemlich dilettantisch, aber irgendwie muss man ja anfangen.
Ich bin für jede Hilfe sehr dankbar,
Viele Grüße,
kikimat

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub Kopieren() Dim m As Integer Dim wsBasis As Worksheet Dim wsAktuell As Worksheet Dim rngC As Range, rngF As Range Set wsAktuell = ThisWorkbook.Worksheets("Tabelle1") Set wsBasis = ThisWorkbook.Worksheets("Tabelle2") Application.ScreenUpdating = False With wsAktuell For Each rngC In .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp)) Set rngF = wsBasis.Columns(1).Find(rngC, lookat:=xlWhole) If Not rngF Is Nothing Then For m = 1 To 3 If rngF.Offset(, m) "" Then rngC.Offset(, m) = rngF.Offset(, m) Next m End If Next End With End Sub

Hallo,
bei mir nur alle aus Tab1, die in Tab2 nicht vorhanden sind.

Sub Kopieren()
Dim m As Integer
Dim wsBasis As Worksheet
Dim wsAktuell As Worksheet
Dim wsListe As Worksheet
Dim rngC As Range, rngF As Range
Set wsAktuell = ThisWorkbook.Worksheets("Tabelle1")
Set wsBasis = ThisWorkbook.Worksheets("Tabelle2")
Set wsListe = ThisWorkbook.Worksheets("Tabelle3")
Application.ScreenUpdating = False
With wsAktuell
For Each rngC In .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp))
Set rngF = wsBasis.Columns(1).Find(rngC, lookat:=xlWhole)
If Not rngF Is Nothing Then
For m = 1 To 3
If rngF.Offset(, m)  "" Then rngC.Offset(, m) = rngF.Offset(, m)
Next m
Else
wsListe.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = rngC
End If
Next
End With
Application.ScreenUpdating = True
End Sub

Gruß
Rudi

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Find Funktion in VBA

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread