Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1484to1488
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Selektives Kopieren aus 2 Dateien in eine dritte

Selektives Kopieren aus 2 Dateien in eine dritte
30.03.2016 18:09:56
Max

Hallo Liebe Community!
Auf die Gefahr hin mich hier lächerlich zu machen bitte ich euch doch um Hilfe!
Habe selber sehr wenig Erfahrung mit VBA und da ich seit 1 Woche nicht weiterkomme und auch in diversen Foren nicht erfolgreich war hier also mein erster Post!
Hintergrund:
Es gibt zwei Excel-Dateien mit verschiedenen (auch doppelt vorkommenden Nummern)!
Zur Vereinfachung nenne ich sie hier Liste A und Liste B.
Liste A umfasst knapp 1000 Zeilen während Liste B nur knapp 400 Zeilen hat.
Das Makro soll alle Zeilen aus Liste A in eine dritte neue Excel-Datei kopieren (in welcher ich auch das Makro schreibe). Anschließend sollen alle Zeilen welche NUR in Liste B vorkommen unten an die neue Liste angehängt werden!
Das Kopieren der Liste A habe ich schon hinbekommen, hänge jetzt allerdings seit längerem an der Selektion der NUR in Liste B enthaltenen Zeilen.
Habe bereits versucht mit anderen Beiträgen welche ich angepasst habe mein Problem zu lösen (z.B. mit einem Array oder .Find) beherrsche allerdings die Syntax so schlecht dass ich mich nun doch hilfesuchend an euch wende!
Sollte etwas unklar sein bitte einfach posten, werde regelmäßig hier reinschauen!
Vielen Dank schonmal im Voraus!
Gruß
Max

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Beispieldatei?
30.03.2016 18:46:02
Michael
Hi Max,
die Frage ist etwas schwammig:
- einerseits sprichst Du von "Nummern",
- andererseits von "Zeilen".
Ich verstehe das vorläufig so, daß Daten aus Liste mit gleicher "Nummer" übernommen werden sollen, aber nur, wenn weitere Spalten unterschiedlich sind.
Ist das so?
Man kann das alles in händischen Schleifen programmieren, aber der einfachste Weg sollte sein, alle Daten untereinander zu kopieren und in geeigneter Weise zu verformeln & sortieren - oder man nimmt "Duplikate entfernen".
Alles Weitere am besten mit Beispieldatei(n).
Schöne Grüße,
Michael

Anzeige
AW: Beispieldatei?
30.03.2016 19:23:49
Max
Hallo Michael,
erstmal Danke für die schnelle Antwort!
Da ich das Original leider unter Verschluss halten muss habe ich auf die schnelle ein Mini-Mini-Beispiel erstellt! (Man nehme einfach an dass jedes Tabellenblatt eine Datei darstellt)
Da meine Formulierung nicht so recht verständlich war versuche ich es mal erneut:
Liste A enthält eine gewisse Anzahl an Zeilen und Spalten welche größtenteils gefüllt sind! Die NUMMER ist allerings IMMER vorhanden und kann zur identfikation der entsprechenden Zeile genutzt werden.
Liste B enthält ebenfalls ähnliche Daten.
Einige Daten der Liste B sind bereits in Liste A enthalten, jedoch nicht alle!
Das Makro soll nun:
- ALLE Zeilen und Spalten aus Liste A in eine neue Datei kopieren
- Herausfinden welche Daten aus Liste B nicht in Liste A enthalten sind
- Alle Daten welche NUR in Liste B sind ebenfalls in die neue Datei kopieren (am besten einfach unten dranhängen
Und zu deinem Vorschlag: Die Reihenfolge sollte nicht verändert werden, also zuerst sollen die aus Liste A kopierten Daten kommen und anschließend die aus Liste B!
Meine Überlegung ging in folgende Richtung:
Vergleiche die Nummer der ersten Zeile aus Liste B mit ALLEN Nummern aus Liste A (falls diese Nummer einmal vorkommt kann sofort abgebrochen werden), und falls diese Nummer NIE vorkommt soll sie kopiert werden. Und falls darunter genau die gleiche Nummer wieder kommt (wie in meinem Beispiel ja auch der Fall) soll diese ebenfalls kopiert werden.
Habe es mit mit zwei For Schleifen versucht allerdings ohne Erfolg. Genauso ging es mir bei dem Versuch ein Array zu nutzen oder .Find() einzubauen da ich die Logik dahinter nicht verstanden habe.
Ist alles etwas verwirrend, ich hoffe ich konnte das ganze etwas klarer machen!
Danke & Viele Grüße
Max

Anzeige
AW: Beispieldatei?
30.03.2016 19:25:32
Max
Ist die Beispiel-Datei angekommen? Wie gesagt bin neu hier, falls ich etwas falsch gemacht bitte Rückmeldung!!

Beispieldatei: Über Button 'Zum File-Upload' ...
30.03.2016 20:07:04
Luc:-?
…gehen und dort den Anweisungen folgen, Max;
dazu gehört auch, dass der im Kasten gezeigte Link kopiert und in deinen Beitrag derart eingefügt wird, dass er entweder nicht direkt mit anderem Text verbunden ist, sondern mit einem Leerzeichen oder Zeilenumbruch Abstand hält oder per HTML-Tags als solcher gekennzeichnet wird: <a href="derLink">beliebigerHinweisText</a>
Da dein Text keinen Link enthält, kann auch niemand auf deine BspDatei zugreifen!
Übrigens, der kleine grüne Text ganz unten ist ein per HTML-Tags wie beschrieben formulierter Link!
Gruß, Luc :-?
Besser informiert mit …

Anzeige
AW: Beispieldatei: Über Button 'Zum File-Upload' ...
30.03.2016 20:53:34
Max
Also, ich entschuldige mich für dieses Chaos hier!
https://www.herber.de/bbs/user/104672.xlsx
Hier nochmal zum Verständis farblich markiert was ich am Ende gerne haben würde!
Gruß
Max

Warum das Rad neu erfinden?
31.03.2016 07:30:51
RPP63
Hallo!
Wie bereits in der ersten Antwort stand:
Kopiere beide Listen untereinander und wende Daten, Duplikate entfernen auf alle drei Spalten an.
Braucht keine Zeile Code und ist auch händisch in weit weniger als einer Minute zu erledigen.
Gruß Ralf

Anzeige
ergänzend
31.03.2016 07:35:18
RPP63
Warum sollen absolut identische Datensätze erhalten bleiben???
z.B. Hut, 3124, 1 aus Quelle 1 kommt zweimal vor, auch in "neuer Datei"???
Ich lasse den Thread mal auf unbeantwortet stehen.
Gruß Ralf

ohne Doppelte mit Dictionary
31.03.2016 10:56:20
Michael
Hi zusammen,
mir fehlt da irgendwie eine "eindeutige" Information...
Daß Daten doppelt vorkommen könnten, wenn es sich um Aufträge handelt (das zweite Pils wurde von der gleichen Person bereits bestellt, obwohl das erste noch in Arbeit ist), sehe ich noch ein.
Was aber in der Praxis vorhanden sein müßte, ist entweder eine laufende Nr., eine Kundennr., ein Zeitstempel oder irgendwas - um einzelne Zeilen hinterher irgendwie zuordnen zu können.
Aber das nur grundsätzlich.
Wenn ich mir die Beispieldaten ansehe, ist es so, daß die aus Quelle2 zu übernehmenden Zeilen durchweg höhere Nummern haben als in Quelle1: also könnte ein Algorithmus so aussehen:
a) ermittle die höchste Nummer in Quelle1
b) kopiere aus Quelle2 alles, was eine höhere als die höchste Nr. in Quelle1 hat.
Dieser Fakt wurde im Text nicht erwähnt, also bitte ich um Mitteilung, ob das so ist oder nicht.
So, jetzt aber richtig: in der beiliegenden Datei habe ich einen (später verworfenen) Versuch unternommen, das mit Sortierung/Formel hinzubekommen - das funktioniert nicht richtig, HÄTTE aber den Vorteil gehabt, daß sich das mit dem Makrorekorder schön aufzeichnen läßt und mit minimaler, händischer Nachbearbeitung funktioniert (hätte).
Jetzt habe ich ein neues Blatt angelegt: Q1+Q2-Dic mit zwei Buttons - zum Kopieren und zum Leeren des Bereichs.
Wie der Name schon andeutet, habe ich ein "Dictionary" eingesetzt, das ist eigentlich immer dann gut, wenn es um "Doppelte" bzw. die Vermeidung derselben geht.
Außerdem flutscht's.
Der Code:
Sub kopierenDic()
Dim o As Object
Dim von&, bis&, z&, i&, j&
Dim a As Variant
von = 3
bis = Sheets("Quelle1").Range("b" & Rows.Count).End(xlUp).Row
Sheets("Quelle1").Range("A" & von & ":C" & bis).Copy ActiveSheet.Range("A3")
a = Sheets("Quelle1").Range("A" & von + 1 & ":C" & bis)
' von + 1  = ohne Überschrift
Set o = CreateObject("scripting.dictionary")
For i = 1 To UBound(a, 1): o(a(i, 1) & "|" & a(i, 2) & "|" & a(i, 3)) = 1: Next
bis = Sheets("Quelle2").Range("b" & Rows.Count).End(xlUp).Row
a = Sheets("Quelle2").Range("A" & von + 1 & ":C" & bis)
z = 0
For i = 1 To UBound(a, 1)
If Not o.exists(a(i, 1) & "|" & a(i, 2) & "|" & a(i, 3)) Then
z = z + 1
For j = 1 To 3: a(z, j) = a(i, j): Next
End If
Next
von = ActiveSheet.Range("b" & Rows.Count).End(xlUp).Row + 1
Range("A" & von).Resize(z, 3) = a
End Sub
Die Datei: https://www.herber.de/bbs/user/104677.xlsm
Happy Exceling,
Michael
P.S.: ein sehr handlicher, englischer Text zu Dictionaries ist hier zu finden:
http://www.snb-vba.eu/VBA_Dictionary_en.html

Anzeige
AW: ohne Doppelte mit Dictionary
31.03.2016 17:50:14
Max
Hallo Michael,
Vielen Dank für deine Mühe!!!
Habe heute auch noch wenig gebastelt und habe es (meiner bescheidenen Meinung nach) auch so gelöst! :-)
Code siehe unten, wäre super falls ihr den nur mal kurz überfliegen könntet! Er funktioniert zwar soweit aber das Vertrauen in meine Fähigkeiten in Sachen Fehlererkennung sind eher begrenzt!
Für Verbesserungsvorschläge bin ich immer Dankbar!
Sub Test()
Dim Lrow_Quelle1 As Integer
Dim Lrow_Quelle2 As Integer
Dim i As Integer
Dim a As Integer
Dim n As Integer
Dim x As Integer
'----------------------------------------------------------------------------------------------- _
'Übernahme der Quelle1 in neues Dokument
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks.Open (ThisWorkbook.Path & "\Quelle1\Excel-Quelle1.xlsx")
Lrow_Quelle1 = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Workbooks.Open(ThisWorkbook.Path & "\Quelle1\Excel-Quelle1.xlsx").Close
Set ext_wb_ExcelQuelle1 = Workbooks.Open(ThisWorkbook.Path & "\Quelle1\Excel-Quelle1.xlsx")
ext_wb_ExcelQuelle1.Sheets("Tabelle1").Range("A1:A" & Lrow_Quelle1).Copy
ThisWorkbook.Sheets("Tabelle1").Range("A1").PasteSpecial
ext_wb_ExcelQuelle1.Close
'----------------------------------------------------------------------------------------------- _
'Vergleich Der Listen bzgl. Vollständigkeit
Workbooks.Open (ThisWorkbook.Path & "\Quelle1\Excel-Quelle1.xlsx")
Workbooks.Open (ThisWorkbook.Path & "\Quelle1\Excel-Quelle2.xlsx")
Lrow_Quelle2 = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
n = 1
For i = 1 To Lrow_Quelle2 Step 1
For a = 1 To Lrow_Quelle1 Step 1
If Workbooks("Excel-Quelle2.xlsx").Sheets("Tabelle1").Cells(i, 1) <> Workbooks("Excel- _
Quelle1.xlsx").Sheets("Tabelle1").Cells(a, 1) Then
If a = Lrow_Quelle1 Then
x = Lrow_Quelle1 + n
Workbooks("Excel-Quelle2.xlsx").Sheets("Tabelle1").Cells(i, 1).Copy
Workbooks("Excel-Übergeordnet.xlsm").Sheets("Tabelle1").Cells(x, 1).PasteSpecial
n = n + 1
'a = 1
GoTo nächstes_a
Else: GoTo nächstes_a
End If
Else: 'a = 1
GoTo nächstes_i
End If
nächstes_a: Next a
nächstes_i: Next i
Workbooks("Excel-Quelle1.xlsx").Close
Workbooks("Excel-Quelle2.xlsx").Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Ich versuche jetzt erstmal deinen Code zu verstehen.
Vielen Herzlichen Dank!
VG
Max

Anzeige
AW: ohne Doppelte mit Dictionary
01.04.2016 16:24:31
Michael
Hi Max,
wenn Du jede Zelle einzeln kopierst, kannst bei größeren Datenmengen Kaffeetrinken gehen.
Ich habe meinen Code um externe Datein ergänzt:
Sub kopierenDicFile()
Dim o As Object
Dim von&, bis&, z&, i&, j&
Dim a As Variant
Dim dieses As Workbook, extern As Workbook
Dim d As String
'Erst mal schaun, was Quelle hat...
d = ThisWorkbook.Path & "\Quelle1\Excel-Quelle2.xlsx"
If Dir(d) = "" Then MsgBox d & vbLf & "nicht gefunden": Exit Sub
d = ThisWorkbook.Path & "\Quelle1\Excel-Quelle1.xlsx"
If Dir(d) = "" Then MsgBox d & vbLf & "nicht gefunden": Exit Sub
Set dieses = ActiveWorkbook
'Quelle1 Einlesen und in Dictionary stecken
Set extern = Workbooks.Open(d, , False) ' nur lesend
bis = extern.Sheets("Tabelle1").Range("b" & Rows.Count).End(xlUp).Row
von = extern.Sheets("Tabelle1").Range("b" & bis).End(xlUp).Row
'MsgBox von & " : " & bis
extern.Sheets("Tabelle1").Range("A" & von & ":C" & bis).Copy _
dieses.Sheets("Q1+Q2Dic").Range("A3")
a = extern.Sheets("Tabelle1").Range("A" & von + 1 & ":C" & bis)
extern.Close
Set o = CreateObject("scripting.dictionary")
For i = 1 To UBound(a, 1): o(a(i, 1) & "|" & a(i, 2) & "|" & a(i, 3)) = 1: Next
'Quelle 2 einlesen
d = ThisWorkbook.Path & "\Quelle1\Excel-Quelle2.xlsx"
Set extern = Workbooks.Open(d, , False) ' nur lesend
bis = extern.Sheets("Tabelle1").Range("b" & Rows.Count).End(xlUp).Row
von = extern.Sheets("Tabelle1").Range("b" & bis).End(xlUp).Row
'MsgBox von & " : " & bis
a = extern.Sheets("Tabelle1").Range("A" & von + 1 & ":C" & bis)
extern.Close
'vermantschen
z = 0
For i = 1 To UBound(a, 1)
If Not o.exists(a(i, 1) & "|" & a(i, 2) & "|" & a(i, 3)) Then
z = z + 1
For j = 1 To 3: a(z, j) = a(i, j): Next
End If
Next
von = ActiveSheet.Range("b" & Rows.Count).End(xlUp).Row + 1
Range("A" & von).Resize(z, 3) = a
End Sub
Die Datei: https://www.herber.de/bbs/user/104715.xlsm
Falls Du irgendwo ein konkretes Verständnisproblem hast, frage halt nach...
Schöne Grüße,
Michael
P.S.: die Ermittlung der oberen und unteren Zeilen habe ich übrigens in Spalte B vorgenommen, da in Deinen Beispielen nicht immer ein Wert in A steht. Der Code für die unterste Zeile ist klar, es sei nur erwähnt, daß die oberste Zeile (im Beispiel war es ja immer die 3., in Deinem Code aber nicht) nur dann richtig ermittelt wird, wenn die Spalte B keine leeren Zellen enthält.

Anzeige

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige