acht85
Goto Top

Inhalte vergleichen - Excel VBA

Hallo lieber User,

ich habe ein kurze Frage und würde mich sehr freuen, wenn ihr mir damit weiterhelfen könnt.

Ich habe 2 Tabelle (A+B)
Tabelle A enthält Namen (Master meiner Name)
Tabelle B enthält den Namen (leider nicht immer identisch) und Materialnummern.

Monatlich kommt eine neue Tabelle B heraus in der ggf. neue Materialnummern dazugekommen sind.
Ich würde gerne Tabelle A, also meinen Master nutzen um monatlich nachzuschauen welche neuen Materialnummern dazu gekommen sind. Ich dachte daran, dass ich die beiden Namensspalten auf enthält miteinander vergleiche und wenn der Name aus meiner Masterdatei (Tabelle A) in Tabelle B vorkommt soll mit die zugehörige Materialnummer in eine neue Tabelle kopiert werden
Dafür habe ich mir eine Hilfspalte in Tabelle A gebastelt, die mir den Namen in *[Name]* umwandelt. Via Makro lasse ich Tabelle 2 mit meinem *[Name]* filtern und kopiere mir nach jeden *[Name]* die Ergebnisse in eine neue Tabelle.
Das funktioniert auch problemlos.
Allerdings würde ich mir gerne zusätzlich den echten Namen aus Tabelle 1 neben meine eben eingefügte Ergebnisse eintragen lassen. Doch leider überschreibt mir mein Makro immer alle vorherigen Einträge in Spalte C.
Irgendwo habe ich einen Denkfehler bzw. vergessen einzubauen, dass der tatsachliche Name aus Tabelle A x mal in Tabelle 3 eingefügt werden soll, ABER unterhalb des letzten Eintrags in Spalte C.
Heißt wenn ich beim Filtern 5 Ergebnis bekomme und diese kopiere, soll auch 5 mal der Name in Spalte C kopiert werden. Alle kommenden Ergebnisse sollen jeweils unter den vorhandenen eingefügt werden.

Anbei das Makro.

Sub test()
For i = 1 To ThisWorkbook.Sheets("Tabelle1").UsedRange.Rows.Count  
ThisWorkbook.Sheets("Tabelle2").Range("$A$1:$B$118862").AutoFilter Field:=2, Criteria1:=ThisWorkbook.Sheets("Customer").Range("C" & i)  
ThisWorkbook.Sheets("Tabelle2").UsedRange.Offset(1).Copy  
ThisWorkbook.Sheets("Tabelle3").Cells(Sheets("Tabelle3").Range("A65536").End(xlUp).Offset(1, 0).Row, 0) _  
.PasteSpecial Paste:=xlPasteValues
For j = 1 To ThisWorkbook.Sheets("Tabelle3").Cells(Rows.Count, "A").End(xlUp).Row - 1  
ThisWorkbook.Sheets("Tabelle1").Range("A" & i).Copy  
ThisWorkbook.Sheets("Tabelle3").Cells(j, 3).Offset(1).PasteSpecial Paste:=xlPasteValues  
Next j
ThisWorkbook.Sheets("Tabelle2").ShowAllData  
Next i
End Sub

Wäre super, wenn mir jemand helfen könnte.

Content-Key: 357908

Url: https://administrator.de/contentid/357908

Printed on: April 26, 2024 at 04:04 o'clock

Member: eisbein
eisbein Dec 12, 2017 at 08:43:43 (UTC)
Goto Top
Guten Morgen!

Monatlich kommt eine neue Tabelle B heraus in der ggf. neue Materialnummern dazugekommen sind

Das hat aber nicht zufällig etwas mit DATANORM zu tun?

Gruß
eisbein
Member: Acht85
Acht85 Dec 12, 2017 at 09:38:39 (UTC)
Goto Top
Hallo,

nein, ich denke nicht das es etwas mit DATANORM zu tun. Ich muss auch gestehen, dass ich nicht ganz genau weiß was du meinst.
Member: eisbein
eisbein Dec 12, 2017 updated at 09:41:57 (UTC)
Goto Top
dass ich nicht ganz genau weiß was du meinst

Dann hat es nichts mit DATANORM zu tun. face-wink

Gruß
eisbein
Member: eisbein
eisbein Dec 12, 2017 at 09:47:46 (UTC)
Goto Top
Stell doch, zur besseren Verständlichkeit, einen Screenshot deiner beiden Tabellen A und B rein.

Gruß
eisbein
Member: Acht85
Acht85 Dec 12, 2017 at 10:23:29 (UTC)
Goto Top
Anbei 2 Screenshots meiner Tabellen mit Dummy Daten.
tabelle 2
tabelle 1
Member: Acht85
Acht85 Dec 12, 2017 at 11:20:44 (UTC)
Goto Top
Ich sehe gerade, dass der Screenshot in Tabelle 1 nicht ganz passt. Ich greife tatsächlich auf Spalte C zu nicht D. Aber soweit funktioniert ja auch alles. Nur als kurzer Hinweis.

Schon mal sorry dafür.
Member: eisbein
eisbein Dec 12, 2017 at 11:35:04 (UTC)
Goto Top
Bin gerade nicht vor Ort um direkt mit Excel zu testen. Melde mich noch.
Member: eisbein
Solution eisbein Dec 13, 2017 updated at 07:55:45 (UTC)
Goto Top
Hallo!

Ich habe mal folgenden Code zusammen gebastelt

For i = 1 To ThisWorkbook.Sheets("Tabelle1").UsedRange.Rows.Count  
  ThisWorkbook.Sheets("Tabelle2").Range("$A$1:$B$118862").AutoFilter Field:=2, Criteria1:=ThisWorkbook.Sheets("Tabelle1").Range("C" & i)  
  Beginn = Worksheets("Tabelle3").Range("A65536").End(xlUp).Offset(1, 0).Row + 1  
  ThisWorkbook.Sheets("Tabelle2").UsedRange.Offset(1).Copy Destination:=Worksheets("Tabelle3").Range("A" & Worksheets("Tabelle3").Range("A65536").End(xlUp).Offset(1, 0).Row + 1)  
  Ende = Worksheets("Tabelle3").Range("A65536").End(xlUp).Offset(1, 0).Row - 1  
  For j = Beginn To Ende
    ThisWorkbook.Sheets("Tabelle3").Range("D" & j) = ThisWorkbook.Sheets("Tabelle1").Range("A" & i)  
  Next j
Next i

Ich hoffe ich habe dein Problem richtig verstanden face-wink

Welche Office Version verwendest du?

Gruß
eisbein

Edit: Ich musste zum Filtern die Einträge der Tabelle 1, Spalte D ohne Hochkomma eintragen - also statt "*ABC*" nur *ABC*
Member: Acht85
Acht85 Dec 13, 2017 at 08:57:36 (UTC)
Goto Top
Du bist einfach genial!! Genau das habe ich mir vorgestellt. :o)))))
Danke dafür.
Ich verwende Office 2013.

Der Scrennshot mit den "" war komplett falsch. Hatte mich zuerst daran versucht arrCriteria(0) = "*ABC*" in meinem Makro zusammenzubasteln. Ist mir allerdings immer nach 4 Einträgen abgebrochen.
Sorry für die Verwirrung, war ein Screenshot einer alten Datei.

Aber super das du mir weitergeholfen hast. Vielen, vielen Dank.
Ich wünsche noch einen angenehmen Tag.
Member: eisbein
eisbein Dec 13, 2017 at 09:05:06 (UTC)
Goto Top
Hallo!

Freut mich, dass es klappt.
Den Code könnte man sicher noch optimieren - ich habe aber einfach auf dein Beispiel aufgebaut, damit du es bei Bedarf anpassen kannst.

Gruß
eisbein