Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1716to1720
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Tabellen vergleichen

Tabellen vergleichen
24.10.2019 10:25:56
Manfred
Hallo zusammen,
ich habe mal wieder ein Problem.
Ich habe das u.g. Makro in den tiefen von Herber.de gefunden.
Das Makro sollte eigentlich Daten aus der Quelle.xlsx nach Ziel.xlsm vergleichen und übertragen. Ich habe einiges angepasst. Das Makro läuft mit Excel 2013 durch, jedoch werden keine Daten übertragen. Das Makro sollte in der Ziel.xlsm sein da sich die Quelle.xlsx immer wieder ändert.
Formate die mit einem sverweis später bearbeitet werden: 12345678, ZS123456 und 00123456787
Funktion des Makros:
Quelle.xlsx, Daten A2:AC40.000 (Variabel)
In Spalte A stehen die Werte zum Vergleichen.
Ziel.xlsm ab A2 mit Quelle.xlsx alle Zellen 1zu1 vergleichen und Spaltenweise (z.B.: A, B, H, K) nach Ziel.xlsm übernehmen.
Fehlende Daten in Ziel.xlsm Spalte A in der eintragen.
Neue Daten müssen dann nach dem letzten Eintrag in Ziel.xlsm Spalte A zugefügt werden.
Es dürfen keine Daten gelöscht werden.
zusätzlicher Wunsch:
Bei Änderungen der Daten in Ziel.xlsm, diese zellenweise Orange markieren.
Ich hoffe ich habe das einigermaßen verständlich geschrieben.
Die Beschreibungen im Makro stimmen nicht ganz.
Mit freundlichen Grüßen
Manfred
Sub Datenabgleich_01()
'Daten aus zwei Tabellen abgleichen per Schlüsselspalte
Dim wbQuelle As Workbook, wksQuelle As Worksheet, vAuswahl
Dim wbZiel As Workbook, wksZiel As Worksheet
Dim varSchluessel, lSpalteSchluessel As Long
Dim Zelle As Range, rBereich As Range
Dim ZeileQuelle As Long, ZeileZiel As Long
'Quelldatei auswählen
vAuswahl = Application.GetOpenFilename( _
FileFilter:="Excel (*.xls;*.xlsx;*.xlsb;*.xlsm),*.xls;*.xlsx;*.xlsb;*.xlsm", _
Title:="Bitte Datei mit Quelldaten auswählen")
If vAuswahl = False Then GoTo Beenden
'Tabelle in der Inhalte eingetragen werden sollen
'Set wbZiel = ActiveWorkbook   ' oder = Workbooks("Ziel.xlsm") 'Name anpassen!
Set wbZiel = Workbooks("Ziel.xlsm") 'Name anpassen!
Set wksZiel = wbZiel.Worksheets("Tabelle1") 'Name - anpassen
'Nr. der Schlüsselspalte in Zieldatei
lSpalteSchluessel = 1 'ggf Anpassen
With wksZiel
'Letzte Datenzeile in Zieltabelle Spalet A
ZeileZiel = .Cells(.Rows.Count, lSpalteSchluessel).End(xlUp).Row
'Beich mit ID-Nummern im Zielblatt
Set rBereich = .Range(.Cells(2, lSpalteSchluessel), .Cells(ZeileZiel, lSpalteSchluessel))
End With
'Tabelle mit ggf. neuen Daten
Set wbQuelle = Workbooks.Open(Filename:=vAuswahl, ReadOnly:=True)
Set wksQuelle = wbQuelle.Worksheets("Tabelle1") 'Export
Application.ScreenUpdating = False
With wksQuelle
lSpalteSchluessel = 1 'Spalte mit ID-Code in Quelldatei
For ZeileQuelle = 2 To .Cells(.Rows.Count, lSpalteSchluessel).End(xlUp).Row
'Such-Werte aus Zeile in Zieltabelle einlesen
varSchluessel = .Cells(ZeileQuelle, lSpalteSchluessel)
'Name in Bereich mit ID-Code in Zieltabelle suchen
Set Zelle = rBereich.Find(what:=varSchluessel, _
LookIn:=xlValues, lookat:=xlWhole)
If Zelle Is Nothing Then 'Code in Zieldatei nicht vorhanden
'do nothing - keine Daten übertragen
Else
'Daten in Zieltabelle übertragen
ZeileZiel = Zelle.Row
wksZiel.Cells(ZeileZiel, 1) = .Cells(ZeileQuelle, 1) 'Spalte A in A eintragen
wksZiel.Cells(ZeileZiel, 2) = .Cells(ZeileQuelle, 2) 'Spalte B in B eintragen
wksZiel.Cells(ZeileZiel, 3) = .Cells(ZeileQuelle, 8) 'Spalte H in C eintragen
'usw
End If
Next
End With
'Quelldatei wieder schließen
wbQuelle.Close savechanges:=False
Application.ScreenUpdating = True
MsgBox "Fertig!", vbInformation + vbOKOnly, "Datenabgleich"
Beenden:
Set wbQuelle = Nothing: Set wbZiel = Nothing: Set wksQuelle = Nothing: Set wksZiel = Nothing
Set Zelle = Nothing: Set rBereich = Nothing
End Sub

21
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Tabellen vergleichen
28.10.2019 13:59:37
Piet
Hallo
ich sehe das keiner an den Thread heran geht, dazu ein Tipp von mir. Deine Chancen doch eine Lçsung zu bekommen sind grösser, wenn du eine Beispieldatei mit 20-30 Fantasiedaten und die gewünschte Lösung von Hand vorgibst. Hier wird keiner deine Datei nachbauen.
mfg Piet
AW: Tabellen vergleichen
28.10.2019 14:05:15
Manfred
Hallo Piet,
danke für die Antwort.
Ich werde was Bauen.
Mit freundlichen Grüßen
Manfred
AW: Tabellen vergleichen
28.10.2019 15:05:33
Piet
Hallo Manfred
gut, denke bitte daran das dein Thread bald automatisch aus dem Server rausfaellt. Dann kann man nicht mehr antworten! Meine Lösung kannst du aber im Archiv finden. Nur als Hinweis zur Praxis.
mfg Piet
Anzeige
AW: Tabellen vergleichen
28.10.2019 22:53:02
Piet
Hallo Manfred
keine Sorge wegen erschiessen. Ich benutze nur eine Gmmischleuder mit Wattebaellchen!
Anbei deine Beispieldatei zurück. Sie funktioniert, ist aber technisch nicht Optimal.
Es waren mehrere ineinander verschachtelte For Next Schleifen nötig, weil ich mir nicht sicher war ob dein Beispiel stimmt? Das macht sich in der Laufzeit des Makro bemerkbar. Teste bitte mal mit 500 bis 1000 Daten in deiner Beispiel Quelle wie lange das dauert? Das kannst du dann auf 40.000 Zeilen hochrechnen. Wundere dich nicht wenn das 10 Minuten oder laenger dauern kann.
Ein Problem ist, das die Quelle viele Spalten hat, im Ziel Beispiel waren es nur vier! Dazu steht in der Ziel Datei in Spalte D die Überschrift 07 NACH der 11! Da war ich unsicher was genau du vergleichen wiilst? Das Universal Makro prüft jetzt die Überschriften, und vergleicht dann die Daten. Diese Prüfung kann bei vielen Daten, und jede Zelle vergleichen, lange dauern. Schauen wir mal wie es wird?
https://www.herber.de/bbs/user/132832.xlsm
Würde mich freuen wenn der Code jetzt klappt. Ich bin gespannt auf deine Rückmeldung ....
mfg Piet
Anzeige
AW: Tabellen vergleichen
29.10.2019 08:58:23
Manfred
Hallo Piet,
bekomme leider einen Laufzeitfehler 6.
'Schleife zum Daten Übertragen gemäss Überschriften
For i = 3 To lzSpalte 'Ziel Überschriften
For j = 3 To lqSpalte 'Quelle Ðberschrift
If wksZiel.Cells(1, i) = .Cells(1, j) Then
.Cells(zQuelle, j).Copy wksZiel.Cells(lzZiel, i)
a = a + 1: Exit For
End If
Next j
Next i
If a > 0 Then n = n + 1 '<<<<< Laufzeitfehler 6, Überlauf
End If
Bis Zeile 32769 wird nach Ziel.xlsm übertragen.
gesamt Zeilen 71492 aus Quelle.xlsx zu übertragen
Muss man bei den Variablen was ändern ?
Dim lzSpalte As Integer, n As Integer, m As Integer
Mit freundlichen Grüßen
Manfred
Anzeige
AW: Tabellen vergleichen
29.10.2019 11:37:48
Piet
Hallo Manfred
grosses Sorry, mein Fehler!! Aender die Integer Variablen bitte in Long um! Dann wird es klappen.
mfg Piet
AW: Tabellen vergleichen
29.10.2019 15:00:24
Manfred
Hallo Piet,
das Makro läuft sich mit diesen Variablen zu Tode.
'Dim lqSpalte As Integer, i As Integer, j As Integer
Dim lqSpalte As Long, i As Long, j As Long
'Dim lzSpalte As Integer, n As Integer, m As Integer
Dim lzSpalte As Long, n As Long, m As Long
Hast Du mir noch einen Tipp wies besser laufen könnte ?
Ich vermute ich habe zu viel auf LONG angepasst.
mfg
Manfred
AW: Tabellen vergleichen
29.10.2019 18:20:26
Piet
Hallo Manfred
die gute Frage ist wie weit man das Programm optimieren kann? Aus deinen Angaben konnte ich nicht genau erkennen um wieviele Spaltren es sich genau in der Quelle und im Ziel handelt? Du gabst an die Spaltenanzahl sei unbekannt.
Sind es in deiner Ziel Datei wie im Beispiel nur die Spalten C+D die geprüft werden müssen? Dann könnte man das Makro abspecken. Dieses Beispiel war ja mein erster Versuch eine Lösung zu finden, und ich ahnte das die For Next Version zu viel unsinnige Zeit benötigt.
Je genauer du mir angibst welche Spalten in Quelle und Ziel konkret geprüft werden müssen umso genauer kann ich mir Gedanken machen wie man das ganze optimieren kann. Mit dem unteren Test Code kannst du herausfinden um wieviele Spalten und Zeilen es sich in der Quelle handelt. Sind sie mit der Zieldatei 1:1 übereinstimment? Dort steht "Überschrift 07" hinter der "Überschrift 11". Aus dem Grund muss die For Next Suchschleife jedesmal bei Spalte 3 von neuem beginnen. Das kostet alles unnötige Zeit. Bei 100 Daten merkt man das nicht!
Ich überlege mal ob mir noch eine günstigere Lösung einfaellt? Habe da eine wage Idee ...
Ich müsste dazu aber konkret wissen wieviele Spalten in der Zieldatei geprüft werden müssen.
mfg Piet
Sub test()
Dim lSpa As Integer, lz1 As Long
lz1 = Cells(Rows.Count, 1).End(xlUp).Row
lSpa = Cells(1, Columns.Count).End(xlToLeft).Column
MsgBox lSpa & "  Spalten" & vbLf & lz1 & "  Zeilen"
End Sub

Anzeige
AW: Tabellen vergleichen
29.10.2019 20:22:32
Piet
Hallo Manfred
@ Frage an die Kollegen: - Warum habe ich eine Fehlermeldung im Array?
Anbei mal ein neuer Code zum Testen, wo ich versucht habe das Spalten Problem über zwei Arrays zu lösen. Leider kam bei beiden eine Fehlermeldung, die ich mit Resume Next abfangen musste. Mir ist aber unklar warum ein Fehler auftritt. Optisch scheint das Programm trotzdem zu laufen.
Ich bitte den Code mal in meiner Beisieldatei zu testen. Spllte er sschneller sein waere es nett wenn die Kollegen sich des Array Problem annehmen könnten. Da habe ich zu wenig Erfahrung im korreekten programmieren um zu wissen warum der Fehler auftritt? Vielleicht ein Denkfehler?
Sinn der beiden Arrys ist die Spalten Nummer für Quelle und Ziel Überschiften (verschoben!) vor dem bearbeiten der 40.00 Zeilen zu ermitteln, Daöit fallen die For Next Schleifen zum Überschiften suchen weg. Dürfte sich bei soviel Zeilen deutlich bemerkbar machen.
mfg Piet
Option Explicit      '28.10.2019   Oiet   für Herber Gorum
Const FCode = 44     'Farbcode Orange
'Ich gehe von einem 1:1 Abgleich ALLER Spalten aus!
'das kann je nach Anzahl der Spalten bei 40.000 Zeilen dauern!
Sub Datenabgleich_Pfad_Auswahl_Neu_Ay2()
'Daten aus zwei Tabellen abgleichen nach Spalte A!
Dim wbQuelle As Workbook, wksQuelle As Worksheet
Dim wksZiel As Worksheet, lzZiel As Long, vAuswahl
Dim varSchluessel As Variant, rBereich As Range
Dim Zelle As Range, zQuelle As Long  'ZeileQuelle
'Neue Variable für Datenvergleich
Dim lqSpalte As Integer, i As Long, j As Long
Dim lzSpalte As Integer, n As Long, m As Long
Dim Txt1 As String, Txt2 As String, a As Long
Dim lz2, sQArry(100), sZArry(100)  'Spalten Array
'Quelldatei auswählen
vAuswahl = Application.GetOpenFilename( _
FileFilter:="Excel (*.xls;*.xlsx;*.xlsb;*.xlsm),*.xls;*.xlsx;*.xlsb;*.xlsm", _
Title:="Bitte Datei mit Quelldaten auswählen")
If vAuswahl = False Then GoTo Beenden
'Tabelle in der Inhalte eingetragen werden sollen
Set wksZiel = ThisWorkbook.Worksheets("Tabelle1")
Application.ScreenUpdating = False
With wksZiel
'Letzte Datenzeile in Zieltabelle Spalet A
lzZiel = .Cells(.Rows.Count, 1).End(xlUp).Row
'Beich mit ID-Nummern im Zielblatt
Set rBereich = .Range("A2").Resize(lzZiel, 1)
.UsedRange.Offset(1, 0).Interior.ColorIndex = xlNone
End With
'Tabelle mit ggf. neuen Daten
Set wbQuelle = Workbooks.Open(Filename:=vAuswahl, ReadOnly:=True)
Set wksQuelle = wbQuelle.Worksheets("Tabelle1")
'Letzte Spalte in Quelle und Ziel ermitteln
lzSpalte = wksZiel.Cells(1, Columns.Count).End(xlToLeft).Column
lqSpalte = wksQuelle.Cells(1, Columns.Count).End(xlToLeft).Column
With wksQuelle
'** 1. Versuch Code zu optimieren  29.10.
'Nummer der Überschrift Spalten in Array laden
For i = 3 To lzSpalte   'Ziel Überschriften
For j = 3 To lqSpalte   'Quelle Ğberschrift
If .Cells(1, j) = wksZiel.Cells(1, i) Then
sZArry(i - 3) = wksZiel.Cells(1, i).Column
sQArry(i - 3) = .Cells(1, j).Column
End If
Next j
Next i
'Schleife zum Datenvergleich von Quelle mit Ziel
lz2 = .Cells(.Rows.Count, 1).End(xlUp).Row
For zQuelle = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
Application.StatusBar = zQuelle & "  " & lz2
'Such-Werte aus Zeile in Zieltabelle einlesen
varSchluessel = .Cells(zQuelle, 1)
'Name in Bereich mit ID-Code in Zieltabelle suchen
Set Zelle = rBereich.Find(what:=varSchluessel, _
LookIn:=xlFormulas, lookat:=xlWhole)
'Code in Zieldatei nicht vorhanden (unten einfügen)
If Zelle Is Nothing Then
lzZiel = lzZiel + 1: a = 0
'ID Schlüssel und Benennung zuerst auflisten
.Cells(zQuelle, 1).Copy wksZiel.Cells(lzZiel, 1)
.Cells(zQuelle, 2).Copy wksZiel.Cells(lzZiel, 2)
On Error Resume Next  '** unerklaerliche Felermeldung
'Schleife zum Daten Übertragen gemäss Überschriften
For i = LBound(sZArry) To UBound(sZArry)
.Cells(zQuelle, sQArry(i)).Copy _
wksZiel.Cells(lzZiel, sZArry(i))
a = a + 1
Next i
On Error GoTo 0
If a > 0 Then n = n + 1
End If
'Code in Zieldatei auf Übereinstimmung prüfen
If Not Zelle Is Nothing Then
On Error Resume Next  '** unerklaerliche Felermeldung
'Schleife zum Daten Übertragen gemäss Überschriften
For i = LBound(sZArry) To UBound(sZArry)
If wksZiel.Cells(Zelle.Row, sZArry(i))  .Cells(zQuelle, sQArry(i)) Then
wksZiel.Cells(Zelle.Row, sZArry(i)).Interior.ColorIndex = FCode
wksZiel.Cells(Zelle.Row, sZArry(i)) = .Cells(zQuelle, sQArry(i))
m = m + 1
End If
Next i
On Error GoTo 0
End If
Next
End With
'Quelldatei wieder schließen
wbQuelle.Close savechanges:=False
Application.ScreenUpdating = True
Application.StatusBar = Empty
'Info Text für Ausgabe anfertigen
Txt1 = n & "  neue Daten angehangen" & vbLf
Txt2 = m & "  Daten haben sich geändert" & vbLf
MsgBox "Fertig!" & vbLf & Txt1 & Txt2, _
vbInformation + vbOKOnly, "Datenabgleich"
Beenden:  Set wksZiel = Nothing
Set Zelle = Nothing: Set rBereich = Nothing
Set wbQuelle = Nothing: Set wksQuelle = Nothing
End Sub

Anzeige
AW: Tabellen vergleichen
30.10.2019 10:04:05
Manfred
Hallo Piet,
das Ergebnis ist 86 Spalten und 39500 Zeilen.
Das Makro arbeitet mit den umgestellten Variablen auf LONG zu 100%.
Es läuft auch durch jedoch für 8 Spalten A-H der Test_Quelle.xlsx benötigt es ca. 45min.
Folgende Spalten benötige ich aus der Quelle.xlsx
Quelle_Spalte _Quelle_Spaltennr.
C 3
D 4
E 5
F 6
G 7
K 11
R 18
T 20
V 22
Y 25
AY 51
AZ 52
Mit freundlichen Grüßen
Manfred
AW: Tabellen vergleichen
30.10.2019 10:44:44
Piet
Hallo Manfred
hast du den Durchlauf mit dem 1. Makro oder dem 2. Makro mit der neuen Array Funktion getestet?
Etwas verwirrt mich noch. Du schreibst von 8 Spalten A-H, gibst mir für die Quelle aber 12 Spalten an! Stehen diese 12 Spalten im Ziel nebeneinander, und wenn ja ab welcher Spalte. Ab Spalte A oder C?
Fakt bleibt aber, das bei fast 40000 Zeilen und 12 Spalten 474000 Zellen einzeln zu prüfen sind! Das sind 12 If Then Funktionen pro Zeile! Es wird letztendlich eimmer ine Zeitaufwendige Sache bleiben. Vielleicht geht es über Arrays schneller, aber zaubern können da auch die Kollegen nicht.
mfg Piet
Anzeige
AW: Tabellen vergleichen
30.10.2019 12:49:08
Manfred
Hallo Piet,
habe beide Makros laufen lassen.
1000 Zeilen brauchen ca. 2Min. pro Makro. Beide laufen zu 100% richtig.
Nach dem Lauf sind jedoch einige Menüs gesperrt.
Kann ich da noch was Um- oder Einstellen ?
Mit freundlichen Grüßen
Manfred
AW: Tabellen vergleichen
30.10.2019 14:05:25
Piet
Hallo Manfred
upps, da bin ich jetzt verblüfft. weil ich mit beiden Makros vom Befehl her in kein Menü eingreife!
Mir ist wohl bekannt das die Array Version eine Fehlermeldung hat, die ich abfangen musste.
Tritt das bei beiden auf, oder nur bei der ARRAY Version?
Was ist mit der Differzenz von 8 Spalten A-H, zu deiner Angabe von den 12 Spalten in der Quelle?
Da blicke ich noch nicht so ganz durch was ich da genau programmieren muss? Acht Spalten oder zwölf? Und beginnt der Vergleich in der Zieltabelle ab Spalte B oder C?
In A ist ja meines Wissens bei beiden Tabellen die ID Nummer.
mfg Piet
Anzeige
AW: Tabellen vergleichen
30.10.2019 14:22:08
Manfred
Hallo Piet,
meine lieben Kollegen haben mir erst jetzt die Originaldatei gegeben.
Wie gesagt es funktionieren alle Makros.
Ziel.xlsm
Start in Sp_A1=Überschrift, Vergleich ab Sp_A1, wie gehabt.
Änderungswunsch:
Quell.xlsx
Start in Sp_D=Überschrift, Vergleich ab Sp_E1=Überschrift.
Ich müsste jetzt jedoch eine Sp_C auch noch zum Vergleich haben, obwohl diese Rechts von Sp_D ist.
Ansonsten wird alleseingelesen.
Ich kann auch noch ne größere Datei hochladen.
Mit freundlichen Grüßen
Manfred
AW: Tabellen vergleichen
30.10.2019 16:52:06
Manfred
Hallo Piet,
wollte nur sagen dass ich erst wieder am Montag 04.11. da bin.
Mit freundlichen Grüßen
Manfred.
Anzeige
AW: Tabellen vergleichen
30.10.2019 17:05:32
Hajo_Zi
Hallo Manfred,
dann ist der Beitrag nicht mehr in der Forumsliste.

AW: Tabellen vergleichen
30.10.2019 17:08:42
Manfred
Hallo Hajo,
ja ist mir klar.
Dann probier ich am Mo. einen neuen aufzumachen.
Piet, recht herzlichen Dank für die tolle Unterstützung von Dir.
Tolles Forum.
Mit freundlichen grüßen
Manfred
AW: Tabellen vergleichen
05.11.2019 13:29:25
Manfred
Hallo Piet,
ich möchte gerne das Thema nochmals aufnehmen um 2 Dateien zu vergleichen.
Quelle.xlsx
Eindeutiger Vergleich neu Sp_D. Alt Sp_A wie jetzt im Makro
Ca. 40.000 Zeilen
Ca. 87 Spalten
Ziel.xlsm, eindeutiger Vergleich Sp_A, wie gehabt.
Da ich erst jetzt die richtige Quelle.xlsx bekommen habe benötige ich eine kleine Änderung zum
Makro in der Ziel.xlsm
Könntest Du mir bitte Helfen und den Code anpassen, ich raff das nicht so.
Für 40.000 ( 40_Tausend) Zeilen benötigt das Makro etwas lange.
Könnte man noch was an der Geschwindigkeit drehen.
https://www.herber.de/bbs/user/132959.xlsx
https://www.herber.de/bbs/user/132960.xlsm
Mit freundlichen Grüßen
Manfred
Anzeige
AW: Tabellen vergleichen
30.10.2019 17:50:49
Piet
Hallo Manfred
ja, ich mache mache weiter, hat aber keine Eile. Warte deinen neuen Thread ab ....
mfg Piet
AW: neue Beispiel Datei hochladen
30.10.2019 18:00:36
Piet
Hallo Manfred
hast du die Möglichkeit noch eine neue Beispieldatei Quelle und Ziel hochzuladen, mit allen Spalten. Zum Testen reichen ca. 15 Zeilen. Vielen Dank ...
mfg Ğiet

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige