Erneut Makro gesucht :(

Hiho,
es zeigt sich mal wieder, dass es wohl doch besser wäre, sich die einzelnen Scriptsprachen anzueignen.
Ich hab mal wieder ein Problem:
In der Tabelle 1 hab ich insgesamt 3 Spalten.
In Spalte A ist eine (kurz-)Beschreibung.
In der Tabelle 2 sind es auch 3 Spalten, nur in der 1. Spalte ist es eine etwas ausführlichere Beschreibung. In Tabelle 2 sind hinter dieser Beschreibung auch noch 2 Spalten mit ca. 10-stelligen Nummern.
Meine Gesuch ist nun ein Script/Makro, welches den String aus Tabelle 1 / Spalte A
in der Tabelle 2 / Spalte A sucht und wenn es gefunden wird, automatisch die Werte aus Tabelle 2 Spalte B und C in die Tabelle 1 ( auch Spalte B u. C ) kopiert.
Hoffe ist irgendwie verständlich was ich da ausdrücke.
Hier noch eine Test-Datei, zum verdeutlichen worauf ich hinaus möchte.
https://www.herber.de/bbs/user/25727.xls
Es handelt sich natürlich um größere Datenbanken/Tabellen , als ihm Beispiel ;-)
Gruß und dank schon mal
Marco

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub test() Dim R1 As Range, R2 As Range, Rng1 As Range, Rng2 As Range With Sheets(1) Set Rng1 = .Range(.Cells(2, 1), .Cells(65536, 1).End(xlUp)) End With With Sheets(2) Set Rng2 = .Range(.Cells(2, 1), .Cells(65536, 1).End(xlUp)) End With For Each R1 In Rng1 For Each R2 In Rng2 If R2 Like "*" & R1 & "*" Then R1.Offset(0, 1) = R2.Offset(0, 1) R1.Offset(0, 2) = R2.Offset(0, 2) Exit For End If Next R2 Next R1 End Sub

Sub test() Dim R1 As Range, R2 As Range, Rng1 As Range, Rng2 As Range With Sheets(1) Set Rng1 = .Range(.Cells(2, 1), .Cells(65536, 1).End(xlUp)) End With With Sheets(2) Set Rng2 = .Range(.Cells(2, 1), .Cells(65536, 1).End(xlUp)) End With For Each R1 In Rng1 For Each R2 In Rng2 If R2 Like "*" & R1 & "*" And R2.Offset(0,3)= "HerstellerName" Then R1.Offset(0, 1) = R2.Offset(0, 1) R1.Offset(0, 2) = R2.Offset(0, 2) Exit For End If Next R2 Next R1 End Sub

Sub test() Dim R1 As Range, R2 As Range, Rng1 As Range, Rng2 As Range With Sheets(1) Set Rng1 = .Range(.Cells(2, 1), .Cells(65536, 1).End(xlUp)) End With With Sheets(2) Set Rng2 = .Range(.Cells(2, 1), .Cells(65536, 1).End(xlUp)) End With For Each R1 In Rng1 For Each R2 In Rng2 If R2 Like "*" & R1 & "*" And R2.Offset(0, 3) = R1.Offset(0, 3) Then R1.Offset(0, 1) = R2.Offset(0, 1) R1.Offset(0, 2) = R2.Offset(0, 2) Exit For End If Next R2 Next R1 End Sub

Beliebteste Forumthreads (12 Monate)

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread