Tabellen vergleichen... nicht doppelte ausgeben

Private Sub CommandButton1_Click() ' Vergleicht Tabelle 2 mit Tablle 1 und schreibt Werte ' aus Tabelle 2, die in Tabelle 1 nicht vorkammen in Tabelle 3 Dim verg1(60000), verg2(60000), dopp%(60000), num(60000) ' Tabelle 1 einlesen Worksheets("Tabelle1").Activate y = 2 Do While Cells(y, 1) <> "" verg1(y) = Cells(y, 2) y = y + 1 Loop ' Tabelle 2 einlesen Worksheets("Tabelle2").Activate z = 2 Do While Cells(z, 1) <> "" num(z) = Cells(z, 1) verg2(z) = Cells(z, 2) z = z + 1 Loop For r = 2 To y - 1 For s = 2 To z - 1 If r = s Then s = s + 1 If verg1(r) = verg2(s) Then 'And dopp(s) = 0 dopp(s) = 1 Cells(s, 3) = "gleich" End If Next s Next r ' In Tabelle 3 schreiben Worksheets("Tabelle3").Activate zz = 1 For u = 1 To z - 1 If dopp(u) = 0 Then Cells(zz, 1) = num(u) Cells(zz, 2) = verg2(u) zz = zz + 1 End If Next u End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Sebastian
Wenn ich dich richtig verstanden habe, dann sind in beiden Tabellen 60.000 Einträge.
Und diese 2 x 60.000 Einträge sollen miteinander verglichen werden - jeder mit jedem.
Ohne, dass ich mir jetzt deinen Code genauer angesehen habe, ergibt sich für mich daraus diese Rechnung:
Angenommen, der PC benötigt pro Vergleich = 1 Millisekunde:
60.000 x 60.000 = 3.600.000.000 Millisekunden (3,6 Milliarden!)
3.600.000.000 / 1000 = 3.600.000 Sekunden
3.600.000 / 60 = 60.000 Minuten
60.000 / 60 = 1.000 Stunden = 41,67 Tage! :-)
Angenommen, der PC benötigt pro Vergleich = 1 Mikrosekunde:
60.000 x 60.000 = 3.600.000.000 Mikrosekunden (3,6 Milliarden!)
3.600.000.000 / 1000 = 3.600.000 Millisekunden
3.600.000 / 1000 = 3.600 Sekunden
3.600 / 60 = 60 Minuten
60 / 60 = 1 Stunde :-)
Da ich gerad mal keine 2 Dateien mit á 60.000 Einträgen habe :-), kann ich leider keinen Code dafür/damit entwickeln/testen.
Trotzdem weiter viel Glück!
Ciao
Thorsten

Sub vergleich() Dim ldbSuche As Double, ldbSuche2 As Double, ldbZeile As Double, ldbZeile2 As Double, lboTreffer As Boolean Dim ldtStart As Date ldtStart = Time ldbZeile = 1 For ldbSuche = 1 To 60000 For ldbSuche2 = 1 To 60000 If Sheets(2).Range("A" & ldbSuche).Value = Sheets(1).Range("A" & ldbSuche2).Value Then lboTreffer = True Exit For Else ldbZeile2 = ldbSuche End If Next If lboTreffer = True Then lboTreffer = False Else Sheets(3).Range("A" & ldbZeile).Value = Sheets(2).Range("A" & ldbZeile2).Value ldbZeile = ldbZeile + 1 End If Debug.Print ldbSuche Next ldtStart = Time - ldtStart MsgBox "fertig - Dauer: " & ldtStart End Sub

Hallo, Sebastion,
so einfach läßt sich m.E. die vermutlich benötigte Zeit nicht abschätzen, wenn man die Datenstruktur nicht kennt. Für einen Versuch mit Zahlen benötige ich ca. 3,33 Min. für die ersten ca. 3000 Datensätze der Tabelle1, die jeweils mit jedem der 60.000 Datensätze der Tabelle2 verglichen wird, sofern nicht zuvor eine Übereinstimmung aller drei Spaltenwerte festgesellt wird.
Mit zunehmender Datensatzzahl wird die Zeit sich noch erhöhen, da Deine Vorgabe vorsieht, alle Datenzeilen der Tabelle2 zu vergleichen, also immer wieder ab der ersten Datenzeile, auch wenn diese bereits in Tabelle1 entdeckt wurde (s.u.).
Als Datenbasis werden zwei Datenreihen benutzt, die jeweils aus 60.000 Datenzätzen a drei Elementen je Datensatz bestehen, mit 382 unterschiedlichen Datensätzen in den beiden Reihen.

Option Explicit
Sub Vergleich()
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim mark As Long
Dim lastR1 As Long, lastR2 As Long, lastR As Long
Dim r1 As Long, r2 As Long, c As Integer, i As Integer
Set ws1 = Worksheets("Tabelle1")
Set ws2 = Worksheets("Tabelle2")
Set ws3 = Worksheets("Tabelle3")
ws3.Cells.ClearContents
lastR1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
lastR2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
ws1.Select
Dim oldStatusBar
Dim found As Boolean
oldStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Dim StartZeit As Date, EndeZeit As Date, Zeit As Date, msg As String
StartZeit = Time
For r1 = 2 To lastR1
For r2 = 2 To lastR2
found = False
For c = 1 To 3
If Not (Cells(r1, c) = ws2.Cells(r2, c)) Then Exit For
Next c
If c > 3 Then
found = True
Exit For
End If
Next r2
If Not found Then
'Zeile r1 in Tabelle 2 nicht gefunden
mark = mark + 1
ws3.Cells(mark + 1, 1) = r1
For i = 1 To 3
ws3.Cells(mark + 1, i + 1) = Cells(r1, i)
Next i
End If
'Statuszeile aktuallisieren nach jeweil 100 Zeilen in Tabelle1
If (r1 - 1) = 100 * CInt((r1 - 1) / 100) Then
Zeit = Time - StartZeit
msg = r1 - 1 & "/" & lastR1 - 1 & _
" (" & Format((r1 - 1) / (lastR1 - 1), "0.0%") & _
") Zeit:" & Zeit & _
" (Restzeit ~ " & Format((lastR1 - r1 + 1) * (Time - StartZeit) / (r1 - 1), "hh:mm:ss") & ")"
Application.StatusBar = msg
End If
Next r1
Application.StatusBar = False
Application.DisplayStatusBar = oldStatusBar
Set ws1 = Nothing
Set ws2 = Nothing
Set ws3 = Nothing
End Sub

Der Programmcode enthält eine Statuszeileneinblendung mit der Verlaufsinformation, die natürlich auch Berechnungszeit benötigt. Jedoch der Hauptzeitgewinn könnte möglicherweise durch Überprüfung der Struktur der zu vergleichenden Daten erzielt werden. So ist zu überlegen,

ob übereinstimmende Zeilen erneut untersucht werden müssen,

ob über eine Sortierung beider Listen, das Durchsuchen der Liste2 nicht immer am Beginn der Liste gestartet werden muß.
Gruß,
Uwe

Beliebteste Forumthreads (12 Monate)

Tabellen vergleichen... nicht doppelte ausgeben

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Tabellen vergleichen... nicht doppelte ausgeben

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread