Schneller 2 Spalten vergleichen als mit for next

Hallo alle zusammen.
Ich wollte in meiner Tabelle diese Formel durch ein Makro ersetzen (vergleicht 2 spalten in tabelle 1 mit 2 spalten in tabelle 2). in der hoffnung das die performance meiner tabelle dadurch steigt.
(Die Formel steht in ca. 2000 Zeilen
=WENN(SUMMENPRODUKT((Mängelliste!$A$7:$A$398=B3)*(Mängelliste!$B$7:$B$398=D3)) -SUMMENPRODUKT((Mängelliste!$A$7:$A$398=B3)*(Mängelliste!$B$7:$B$398=D3)*(Mängelliste!$E$7:$E$398>0)) >0;"!Mängel!";"")
Im Internet habe ich ein makro gefunden welches ich meiner Tabelle angepasst habe. Es funktioniert auch, allerdings brauch es "ewig"(ca. 2 sec) bis es durchgelaufen ist.
Gibt es vielleicht eine schnellere Möglichkeit als eine For Next Schleife mein Vorhaben umzusetzen?
Private Sub Worksheet_Activate() 'Vergleicht die Spalte A des Tabellenblattes 1 mit der Spalte 2 des Tabelenblattes 2 _ und markiert die doppelten Werte in Hellgelb Dim i As Integer, j As Integer 'Festlegen der Variabeln Application.ScreenUpdating = False EndeA = Worksheets("Netz").Cells(Rows.Count, 2).End(xlUp).Row 'legt das Ende des ersten Bereiches fest EndeB = Worksheets("Mängelliste").Cells(Rows.Count, 1).End(xlUp).Row 'legt das Ende des zweiten Bereiches fest For i = 3 To EndeA 'beginnt bei Zelle 1 und hört bei der letzten ausgefüllten Zelle des Bereiches auf For j = 8 To EndeB If Sheets("Netz").Cells(i, 2) = Sheets("Mängelliste").Cells(j, 1) And Sheets("Netz").Cells(i, 4) _ = Sheets("Mängelliste").Cells(j, 2) And Sheets("Mängelliste").Cells(j, 5) = Empty Then Sheets("Netz").Cells(i, 6) = "!Mängel!" End If 'Fortsetzen der Schleife Next j Next i Application.ScreenUpdating = True End Sub

Private Sub Worksheet_Deactivate()
EndeA = Worksheets("Netz").Cells(Rows.Count, 2).End(xlUp).Row
Range("F3:F" & EndeA) = Empty
End Sub

Gruß alex

Hallo Alex,
um die Makro-Ausführung zu Beschleunigen solltest du während der Ausführung die Bildschirmaktualisierung deaktivieren und den Berechnungsstatus auf "Manuel".
Das Schachteln von 2 For-Next-Schleifen ist hier nicht ideal. Wenn die Anzahl der Zeilen in der Mängelliste nicht wesentlich größer wird, dann spielt das kaum eine Rolle.
Bei langen Listen arbeitet man besser mit der Suchfunktion und eine Do-Loop-Schleife für die innere Schleife.
Generell gilt: VBA ist meistens langsamer als vergleichbare Formeln. Erst bei umfangreichen Tabellen mit komplexeren Matrixformeln, die insbesondere die laufende Aktualisierung der Berechnungen ausbremsen macht es Sinn per VBA zu berechnen und feste Werte in Zellen zu schreiben.
Gruß
Franz

Private Sub Worksheet_Activate()
'Vergleicht die Spalte A des Tabellenblattes 1 mit der Spalte 2 des Tabelenblattes 2 _
und markiert die doppelten Werte in Hellgelb
Dim i As Integer, j As Integer, wksNetz As Worksheet, wksMaengel As Worksheet
Dim vSuchen, sZelle1 As String, Zelle As Range, BereichB As Range
Dim StatusCalc As Long
'Festlegen der Variabeln
Set wksNetz = Worksheets("Netz")
Set wksMaengel = Worksheets("Mängelliste")
Application.ScreenUpdating = False
StatusCalc = Application.Calculation
Application.Calculation = xlCalculationManual
With wksNetz
'legt das Ende des ersten Bereiches fest
EndeA = .Cells(.Rows.Count, 2).End(xlUp).Row
End With
With wksMaengel
'legt das Ende des zweiten Bereiches fest
endeB = .Cells(Rows.Count, 1).End(xlUp).Row
'Bereich mit den Objekten
Set BereichB = .Range(.Cells(8, 1), .Cells(endeB, 1))
End With
For i = 3 To EndeA
'beginnt bei Zelle 1 und hört bei der letzten ausgefüllten Zelle des Bereiches auf
vSuchen = wksNetz.Cells(i, 2).Value 'Objektname merken
'Objekt in Mängelliste suchen
Set Zelle = BereichB.Find(What:=vSuchen, LookIn:=xlValues, lookat:=xlWhole)
If Zelle Is Nothing Then
'do nothing
Else
sZelle1 = Zelle.Address '1. Fundstelle merken
Do
'Kriterien prüfen
If wksNetz.Cells(i, 4) = wksMaengel.Cells(Zelle.Row, 2) _
And wksMaengel.Cells(Zelle.Row, 5) = Empty Then
wksNetz.Cells(i, 6) = "!Mängel!"
Exit Do
End If
Set Zelle = BereichB.FindNext(After:=Zelle)
Loop Until Zelle.Address = sZelle1
End If
'Fortsetzen der Schleife
Next i
Application.ScreenUpdating = True
Application.Calculation = StatusCalc
End Sub
Private Sub Worksheet_Deactivate()
EndeA = Worksheets("Netz").Cells(Rows.Count, 2).End(xlUp).Row
Range("F3:F" & EndeA) = Empty
End Sub

	B	C	D	E	F	G	H
2	Objekt		Typ		Mängel Makro	Mängel Formel
3	Ahrensfelde Stw.		BMA				Format: "!Mangel";;;
4	Anhalter Bahnhof UST		BMA
5	Anhalter Bahnhof UST		EMA		!Mängel!	!Mangel
6	Bad Saarow BSTR		BMA
7	Bad Saarow BSTR		EMA

	A	B	C	D	E	F	G
7	Objekt	Typ	Festgestellte Mängel	Festelldatum	Erledigt Datum	Name	Hilfsspalte
8	Beelitz Heilstätten BSTR	EMA		08.12.2009			Beelitz Heilstätten BSTREMA
9	Gleisdreieck Übergabestation	BMA		03.12.2009			Gleisdreieck ÜbergabestationBMA
10	Olympiastadion Bstr	EMA		02.12.2009			Olympiastadion BstrEMA
11	Ruhleben ESTW	EMA		02.12.2009			Ruhleben ESTWEMA

Schneller 2 Spalten vergleichen als mit for next

Forumthread: Schneller 2 Spalten vergleichen als mit for next

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial

Zwei Spalten in einer Tabelle effizient vergleichen

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

Beliebteste Forumthreads (12 Monate)

Schneller 2 Spalten vergleichen als mit for next

Forumthread: Schneller 2 Spalten vergleichen als mit for next

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

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Infobox / Tutorial

Zwei Spalten in einer Tabelle effizient vergleichen

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread