Vergleich über 2 Tabellen mit Array

Hi zusammen,
ich komm einfach nicht weiter.
Es geht um ein Makro.
Hab jetzt zwar nen Vergleich von 2 Tabellen der auch tut was er soll, aber der Zeitaufwand ist einfach viel zu groß.
Bei 880 Zeilen in Tabelle 1 und 1660 Zeilen in Tabelle 2 benötigt er zur Prüfung auf Übereinstimmung von jeweils 3 gleichen Zellen innerhalb der Zeilen sage und schreibe 12 Minuten.
Gibt es da keine schnellere Möglichkeit per array? *ich muss dazu sagen, arraykenntnisse beschränken sich bei mir auf ein minimum bzw. gehen gegen null.
Wäre also sehr verbunden wenn mir jemand den möglichst fertigen code geben könnte.
Folgende Rahmenbedingungen:
Gegeben:
1 Arbeitsmappe (Name variiert)
2 Tabellenblätter (SAP_Kontr und Akt_Kontr)
Die relevanten Daten sind:
SAP_Kontr Spalte 4 und Akt_Kontr Spalte 1
SAP_Kontr Spalte 18 und Akt_Kontr Spalte 21
SAP_Kontr Spalte 33 und Akt_Kontr Spalte 11
Es gibt also 3 Bedinungen die erfüllt sein müssen.
Wenn alle Bedingungen erfüllt sind, soll die entsprechende Zeile in Akt_Kontr gelöscht werden;
wenn nicht soll die nächste Zeile überprüft werden.
Ich kann jedoch nicht genau sagen, wieviele Zeilen jeweils in den Tabellen vorhanden sind, da diese sehr stark variieren können.
Ich glaub an euch!
Gruß

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Vergleich() Dim LoI as Long Dim LoJ as Long Dim LoLetzte1 as Long Dim LoLetzte2 as Long With Worksheets("Akt_Kontr") LoLetzte1 = IIf(IsEmpty(.Cells(Rows.Count, 1)), .Cells(Rows.Count, 1).End(x1Up).Row,.Rows.Count) _ End With With Worksheets("SAP_Kontr") LoLetzte2 = IIf(IsEmpty(.Cells(Rows.Count, 1)), .Cells(Rows.Count, 1).End(x1Up).Row,.Rows.Count) _ End With For LoI = 1 To LoLetzte1 For LoJ = 1 To LoLetzte2 If Worksheets("Akt_Kontr").Cells(LoI, 1) = Worksheets("SAP_Kontr").Cells(LoJ, 4) and Worksheets( _ "Akt_Kontr").Cells(LoI, 21) = Worksheets("SAP_Kontr").Cells(LoJ, 18) and Worksheets("Akt_Kontr").Cells(LoI, 11) = Worksheets("SAP_Kontr").Cells(LoJ, 33).Value Then Worksheets("Akt_Kontr").Rows(LoI).Delete End If Next LoJ Next LoI Application.CutCopyMode = False End Sub

Hallo Jörg,
sowas?


Sub Vergleich3()
Dim LoI As Long, LoJ As Long, i As Long, j As Long
Dim wsSap As Worksheet, wsAkt As Worksheet
Dim rngDel As Range
Dim Akt1 As Variant, Akt21 As Variant, Akt11 As Variant
Dim SAP4 As Variant, SAP18 As Variant, SAP33 As Variant
Dim sgnStart As Single
Application.ScreenUpdating= False
sgnStart = Timer
Set wsSap = ThisWorkbook.Worksheets("Tabelle2")
Set wsAkt = ThisWorkbook.Worksheets("Tabelle3")
LoI = wsAkt.Cells(Rows.Count, 1).End(xlUp).Row
LoJ = wsSap.Cells(Rows.Count, 1).End(xlUp).Row
Akt1 = wsAkt.Range(wsAkt.Cells(1, 1), wsAkt.Cells(LoI, 1))
Akt21 = wsAkt.Range(wsAkt.Cells(1, 21), wsAkt.Cells(LoI, 21))
Akt11 = wsAkt.Range(wsAkt.Cells(1, 11), wsAkt.Cells(LoI, 11))
SAP4 = wsSap.Range(wsSap.Cells(1, 4), wsSap.Cells(LoJ, 4))
SAP18 = wsSap.Range(wsSap.Cells(1, 18), wsSap.Cells(LoJ, 18))
SAP33 = wsSap.Range(wsSap.Cells(1, 33), wsSap.Cells(LoJ, 33))
For i = 1 To LoI
For j = 1 To LoJ
If Akt1(i, 1) = SAP4(j, 1) Then
If Akt21(i, 1) = SAP18(j, 1) Then
If Akt11(i, 1) = SAP33(j, 1) Then
If Not rngDel Is Nothing Then
Set rngDel = Union(rngDel, wsAkt.Rows(i))
Else
Set rngDel = wsAkt.Rows(i)
End If
End If
End If
End If
Next
Next
If Not rngDel Is Nothing Then rngDel.EntireRow.Delete
Application.ScreenUpdating= True
MsgBox Format(Timer - sgnStart)
End Sub

Gruß Gerd

Beliebteste Forumthreads (12 Monate)

Vergleich über 2 Tabellen mit Array

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Vergleich über 2 Tabellen mit Array

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread