Office: zwei Tabellen (unterschiedliche xls Dateien) vergleichen

Helfe beim Thema zwei Tabellen (unterschiedliche xls Dateien) vergleichen in Microsoft Excel Hilfe um das Problem gemeinsam zu lösen; Hallo zusammen, ich hänge zum Verständnis zwei Beispieldateien an. Ich möchte mittels Makro zwei unterschiedliche Spalten miteinader vergleichen. In... Dieses Thema im Forum "Microsoft Excel Hilfe" wurde erstellt von Badmage, 24. Januar 2006.

Seite 1 von 6

BADMAGE

Badmage

zwei Tabellen (unterschiedliche xls Dateien) vergleichen

Hallo zusammen,

ich hänge zum Verständnis zwei Beispieldateien an.
Ich möchte mittels Makro zwei unterschiedliche Spalten miteinader vergleichen. In der Datei "test_alt" steht in Spalte D eine Sachnr. diese müsste verglichen werden mit der Datei "test_neu" Spalte B.

Gewisse Grundkenntinsse sind in VBA vorhanden, es müsste nämlich wenn Übereinstimmungen gefunden werden die Daten von neu nach alt aktualisiert werden, das denke ich würde ich allein hinbekommen ....

Danach müsste es umgekehrt auch noch abgeglichen werden, heißt, stehen Daten in der Datei neu und in Datei alt nicht, so müssen diese in der Datei alt angefügt werden. Die Datei alt ist also die Masterdatei.

Das ganze müsste mit der Anweisung "GetOpenFilename("Microsoft Excel-Dateien (*.xls), *.xls")" versehen werden, da sich die Datei neu vom Namen und Pfad ändert....

für hilfreiche Antworten bin ich sehr dankbar!

greetinx
Fabian

:)

Badmage, 24. Januar 2006

#1
MRR

MRR

Hallo Fabian,
würde Dir folgender Code helfen?
Code:

Sub Vergleichen()
Dim wbAlt As Workbook
Dim wsAlt As Worksheet
Dim wbNeu As Workbook
Dim wsNeu As Worksheet
Dim ret
Dim blnVorhanden As Boolean
Dim i As Long, j As Long, k As Long, m As Long

Set wbAlt = Workbooks.Open("C:\Daten\Test\test_alt.xls")
Set wsAlt = wbAlt.Worksheets(1)
ret = Application.GetOpenFilename("Microsoft Excel-Dateien (*.xls), *.xls")
If ret = False Then
MsgBox "Abbruch durch User"
wbAlt.Close False
Exit Sub
End If

Set wbNeu = Workbooks.Open(ret)
Set wsNeu = wbNeu.Worksheets(1)
k = wsAlt.Range("A65536").End(xlUp).Row
m = wsNeu.Range("A65536").End(xlUp).Row
For i = 6 To k
For j = 6 To m
If wsAlt.Cells(i, 4) = wsNeu.Cells(j, 2) Then
'Hier Deine Aktionen, was Du dann in der Alt-Datei machen willst (Aktualisieren)
'z.B.
wsAlt.Cells(i, 4).Font.Bold = True
End If
Next
Next

For j = 6 To m
blnVorhanden = False
For i = 6 To k
If wsAlt.Cells(i, 4) = wsNeu.Cells(j, 2) Then
blnVorhanden = True
Exit For
End If
Next
If Not blnVorhanden Then
k = k + 1
wsAlt.Cells(k, 1) = "xxx"
wsAlt.Cells(k, 2) = "xxx"
wsAlt.Cells(k, 3) = "xxx"
wsAlt.Cells(k, 4) = wsNeu.Cells(j, 2)
wsAlt.Cells(k, 5) = wsNeu.Cells(j, 3)
wsAlt.Cells(k, 6) = wsNeu.Cells(j, 4)
'usw. usf., also Schreiben der Werte in die neue Zeile
End If
Next

wbNeu.Close False
If MsgBox("Datei ALT jetzt speichern?", vbYesNo + vbQuestion, "Speichern") = vbYes Then wbAlt.Close True

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ließe sich noch anders lösen. So ist beim derzeitigen Stand des Inhalts die Arbeit in weniger als 1 Sekunde erledigt.

MRR, 25. Januar 2006

#2
BADMAGE

Badmage

Hallo MRR,

vielen Dank für deine schnelle Hilfe!
Ich werde den Code gleich mal ausprobieren.... wie wäre die Dauer bei ungefähr 12.000 Datensätze pro Tabelle (alt / neu).. kann man das abschätzen?

greetz
Fab

Badmage, 25. Januar 2006

#3
BADMAGE

Badmage

zwei Tabellen (unterschiedliche xls Dateien) vergleichen

Hallo MRR,

also in der original Datei stehen natürlich keine "XXX" in den ersten drei Spalten (Datei alt) *Smilie hat das Auswirkungen auf den Code?
Habe den Quellcode mal über die original Datei laufen lassen... da läuft die Prozedur nun schon meh als 15 min.... habs denn grad mal abgebrochen ....
gibts da noch eine etwas schnellere Lösung?

greetz
Fab

Badmage, 25. Januar 2006

#4
MRR

MRR

EXORBITANT!
Im Fall von 30 Zeilen macht das ca. 1800 Vergleiche (alt->neu, neu->alt).
Bei 12.000 Zeilen sind das schon 288.000.000 Vergleiche... Hier wird Excel ganz schön was zu tun haben...
Ich überlege mir mal eine (andere) Möglichkeit.

MRR, 25. Januar 2006

#5
BADMAGE

Badmage

nach meinen Hochrechnungen würden das ca. 22 Stunden ergeben *SMILE*
wenn 3600 eine Sekunde dauern *wink.gif*

Badmage, 25. Januar 2006

#6
MRR

MRR

Hallo Fabian
na, dann auf zum nächsten Code. Dieser dürfte die Aufgabe in 5-10 Minuten (bei jeweils ca. 12.000 Sätzen) erledigt haben.
Ich habe ein wenig kommentiert in der Hoffnung, dass Du durchsteigst... *grins
Code:

Sub Vergleichen()
Dim wbAlt As Workbook '2 Workbook-Variablen
Dim wsAlt As Worksheet
Dim wbNeu As Workbook '2 Worksheet-Variablen
Dim wsNeu As Worksheet
Dim ret 'Öffnen per GetOpenFilename
Dim blnVorhanden As Boolean
Dim i As Long, j As Long, k As Long, m As Long 'Diverse Zähler
Dim rs As ADODB.Recordset 'Recordset für Tabellenzugriff
Dim con As ADODB.Connection 'Connection
Dim c 'Zum Finden eines Eintrages

ret = Application.GetOpenFilename("Microsoft Excel-Dateien (*.xls), *.xls")
If ret = False Then
MsgBox "Abbruch durch User", vbOKOnly + vbExclamation, "Abbruch"
Exit Sub
End If

Application.ScreenUpdating = False

'Die Dateien öffnen und Variablen zuweisen
Set wbAlt = Workbooks.Open("C:\Daten\Test\test_alt.xls")
Set wsAlt = wbAlt.Worksheets(1)

Set wbNeu = Workbooks.Open(ret)
Set wsNeu = wbNeu.Worksheets(1)

Sheets("Tabelle1").Select 'In "Neu"
k = wsAlt.UsedRange.Rows.Count 'Zeilenanzahl feststellen
Set con = Open_Connection(wbAlt.FullName) 'Connection öffnen
Set rs = New ADODB.Recordset 'Tabellendaten lesen
rs.Open "select * from [Tabelle1$A5:M" & k & "]", con, adOpenDynamic, adLockOptimistic

i = 5 'Kopfzeile = Startzeile (+1)
With wsNeu.Range("B:B") 'Suchspalte
Do While Not rs.EOF 'Für alle Alt-Daten prüfen, ob in Neu vorhanden
i = i + 1 'Wir durchsuchen explizit die Spalte B
Set c = .Find(What:=rs.Fields(3).Value, LookIn:=xlValues)
If Not c Is Nothing Then 'Wenn gefunden, hat c einen Wert
Application.StatusBar = "Datenabgleich: Änderungen für Sach-Nr. " & rs.Fields(3).Value
Daten_uebertragen i, rs, wsAlt
End If
rs.MoveNext
Loop
End With

rs.Close 'RS und Connection schließen
con.Close

k = wsNeu.UsedRange.Rows.Count
Set con = Open_Connection(wbNeu.FullName)
Set rs = New ADODB.Recordset
rs.Open "select * from [Tabelle1$A5:M" & k & "]", con, adOpenDynamic, adLockOptimistic

wbAlt.Activate
Sheets("Tabelle1").Select
i = wsAlt.Range("A65536").End(xlUp).Row

'Hier passiert Vergleichbares: Wenn ein neuer Eintrag nicht in Alt ist, dann wird dieser übertragen
With wsAlt.Range("D:D") 'Wir durchsuchen explizit die Spalte D
Do While Not rs.EOF
Set c = .Find(What:=rs.Fields(1).Value, LookIn:=xlValues)
If c Is Nothing Then 'nicht gefunden? Also eintragen
Application.StatusBar = "Datenabgleich: Übertrage Daten für neue Sach-Nr. " & rs.Fields(1).Value
i = i + 1
Daten_uebertragen i, rs, wsAlt
End If
rs.MoveNext
Loop
End With

rs.Close
Set rs = Nothing
con.Close
Set con = Nothing

wbNeu.Close False
If MsgBox("Datei ALT jetzt speichern?", vbYesNo + vbQuestion, "Speichern") = vbYes Then wbAlt.Close True
Application.ScreenUpdating = True

End Sub

Private Function Open_Connection(strFilename As String) As ADODB.Connection
Dim con As New ADODB.Connection
Dim strSQL As String
con.Provider = "Microsoft.Jet.OLEDB.4.0"
strSQL = "Data Source=" & strFilename & ";" & "Extended Properties=Excel 8.0;" & _
"Mode=Share Deny Write;Extended Properties=""HDR=YES;"";Jet OLEDB:System database="""";" & _
"Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Type=35;" & _
"Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;" & _
"Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="""";" & _
"Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;" & _
"Jet OLEDB:Don't Copy Locale on Compact=False;" & _
"Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False"
con.ConnectionString = strSQL
con.Open
Set Open_Connection = con
End Function

Private Sub Daten_uebertragen(i As Long, rs As ADODB.Recordset, ws As Worksheet)
'Diese Prozedur ggf. anpassen udn erweitern
Dim k As Integer
ws.Cells(i, 1) = "xxx"
ws.Cells(i, 2) = "xxx"
ws.Cells(i, 3) = "xxx"
'Voraussetzung: Die Spalten in der Alt-Exceltabelle stimmen mit denen in der Neu überein (ab Spalte D)
For k = 4 To 15
ws.Cells(i, k) = rs.Fields(k - 3).Value
Next
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

MRR, 26. Januar 2006

#7
BADMAGE

Badmage

zwei Tabellen (unterschiedliche xls Dateien) vergleichen

Hallo MRR,

komme erst morgen früh dazu den Code zu probieren *frown.gif* Sorry
habe momentan nur auf der Arbeit Zugriff auf das Inet ....

vielen Dank für Deine Mühe werde mich aufjedenfall morgen nochmal melden!!!
Durch den Code werde ich schon durchsteigen, sah auf den ersten Blick ganz übersichtlich aus *wink.gif* auch vielen Dank dafür!

bis morgen dann

greetinx
Fab

Badmage, 26. Januar 2006

#8
BADMAGE

Badmage

Guten Morgen MRR,

erhalte eine Fehlermeldung:

Benutzerdefinierter Typ ist nicht definiert

folgende Zeile wird makiert:
Private Function Open_Connection(strFilename As String) As ADODB.Connection

greetz
Fab

Badmage, 26. Januar 2006

#9
BADMAGE

Badmage

Hallo,

Fehlermeldung besteht weiterhin *frown.gif*
habe auch schon Verweis etc. gesetz (was ja eigentlich nicht nötig ist, da es ja direkt angesprochen wird über das Makro)

Bin über jede Hilfe dankbar!

greetinx
Fabian

Badmage, 29. Januar 2006

#10
MRR

MRR

Hallo Fabian,
Du hast einen Verweis gesetzt auf "Microsoft ActiveX Data Objects 2.7 Library" (oder welche (höchste) Version Du auch immer verfügbar hast)?

MRR, 30. Januar 2006

#11
BADMAGE

Badmage

Hallo MRR,

nein "natürlich" nicht ... ich hatte fast alle durch, habe Verweise auf Visual Basic for Applications, MS Excel 11.0 Objekt Libary, OLE Automation MSO 11.0 Objekt Libary, dann hatte ich noch DAO *frown.gif* .. ADO hatte ich wie es dann immer so ist nicht ausprobiert....

teste nun den Code ! DANKE für Deine Hilfe!!!

bis gleich nochmal, gebe gleich noch Feedback!

greetz
Fabian

Badmage, 30. Januar 2006

#12
MRR

MRR

zwei Tabellen (unterschiedliche xls Dateien) vergleichen

... und wie schon zu vermuten ist:
ADO =
ActiveX
Data
Objects

*Smilie

MRR, 30. Januar 2006

#13
BADMAGE

Badmage

Hallo MRR,

nun ist es so, dass die Suche durchlaufen wird Dauer ca. 15-20 min ist völlig in Ordnung! Leider werden die übereinstimmenden Daten(fette Makierung) alle unter die Tabelle(alt) geschrieben! Die ursprünglichen Daten aus dieser Tabelle (die oben stehen) werden komischerweise um zwei Spalten verschoben? Wie bekommen wir nun noch diese "Kosmetik" hin? Hast Du noch eine Idee? Wie gesagt, vielen Dank bis hier hin für Deine Mühe!

greetinx
Fabian

Badmage, 30. Januar 2006

#14
BADMAGE

Badmage

Hallo,

das Problem liegt hier:

Code:

For k = 4 To 15
ws.Cells(i, k) = rs.Fields(k - 3).Value
Next
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

die Ziel Zelle ist richitg nur das womit sie gefüllt werden soll nicht ....
hier sollten die Daten aus der "neuen" Tabelle eingefügt werden.

was muß ich in die Klammern anstatt k - 3 schreiben, um die Daten aus der neuen Tabelle zu übernehmen?

im Moment werden "nur" die Daten in der alten Tabelle verschoben ...

greetz
Fab

Badmage, 30. Januar 2006

#15

(Du musst angemeldet oder registriert sein, um eine Antwort erstellen zu können.)

Seite 1 von 6

Thema:

zwei Tabellen (unterschiedliche xls Dateien) vergleichen

Die Seite wird geladen...

zwei Tabellen (unterschiedliche xls Dateien) vergleichen - Similar Threads - Tabellen unterschiedliche xls
Absatz erzeugt unterschiedliche Höhen in Tabellen (-zeile)
in Microsoft Word Hilfe
Absatz erzeugt unterschiedliche Höhen in Tabellen (-zeile): Hallo! Kurzfassung: Ich möchte einfach nur eine Tabelle erstellen, in der Abstände von 6 Pt. vor und nach jeder Tabellenzeile eingefügt sind. Der Zeilenabstand soll dabei "Einfach" sein, sodass...
Sehr große Tabellen vergleichen und Unterschiede hervorheben
in Microsoft Excel Hilfe
Sehr große Tabellen vergleichen und Unterschiede hervorheben: Liebe Community, ich habe mehrere (insgesamt 12) sehr große Tabellen (je 5 Spalten und ca. 12.000 Zeilen). Jede Tabelle stellt dabei Güternummern und Warennummern eines Jahres gegenüber. Ich...
Automatische Verknüpfung mit unterschiedlicher Formatierung?
in Microsoft Word Hilfe
Automatische Verknüpfung mit unterschiedlicher Formatierung?: Hallo liebe Forumsmitglieder, hat jemand evtl. eine Lösung für folgendes Problem für mich? Ich habe in einem Word-Dokument sehr viele Tabellen, deren Titel ich in einem ganz bestimmten Format...
Tabellen untereinander kopieren mit unterschiedlichen Spalten
in Microsoft Excel Hilfe
Tabellen untereinander kopieren mit unterschiedlichen Spalten: Hallo, ich möchte gerne aus zwei Tabellen eine Mastertabelle erstellen. Dazu suche ich ein Makro, mit dem die Daten untereinander kopiert werden.Das Problem ist aber dabei, dass ich zwei...
Tabellen mit unterschiedlicher Spaltenbreite autom. erstellen
in Microsoft Excel Hilfe
Tabellen mit unterschiedlicher Spaltenbreite autom. erstellen: Liebe VBA-Gemeinde, auch nach dem Nutzen der Suchfunktion konnte ich (möglicherweise auch, weil ich falsche Schlüsselworte nutzte?) keine Hilfe zu meinem Problem finden. Mein Ziel ist folgendes:...
Ab- und Angleich unterschiedlicher Schreibweisen in zwei Tabellen
in Microsoft Excel Hilfe
Ab- und Angleich unterschiedlicher Schreibweisen in zwei Tabellen: Guten Morgen zusammen, ich habe folgendes Problem / folgende Probleme: 1. Ich habe zwei Tabellen mit jeweils etwa 20.000 Zeilen und ca. 5.000 Zeilen. In einer der beiden Tabellen steht eine...
Tabellen Prüfungsergebnisse gegenüberstellen und Unterschiedliche Zahlen farblich dar
in Microsoft Excel Hilfe
Tabellen Prüfungsergebnisse gegenüberstellen und Unterschiedliche Zahlen farblich dar: Hallo zusammen, ich suche eine Möglichkeit, wie ich in Excel mehrere Prüfungsergebnisse gegenüberstellen kann und Abweichungen automatisiert farblich darstellen kann. Zum veranschaulichen habe...

Anmelden oder registrieren

Suche

Diese Seite verwendet Cookies, um Inhalte zu personalisieren, diese deiner Erfahrung anzupassen und dich nach der Registrierung angemeldet zu halten.
Auf dieser Website werden Cookies für die Zugriffsanalyse und Anzeigenmessung verwendet.
Wenn du dich weiterhin auf dieser Seite aufhältst, akzeptierst du unseren Einsatz von Cookies.

Akzeptieren Weitere Informationen...

Information ausblenden