3 Spalten vergleichen via Makro

Question

Hallo liebe Wissenden,

irgendwie komme ich vom Thema Spaltenvergleich nicht los.
Jetzt sind es nicht mehr 2 sondern 3 Spalten welche nach dem gleichen Inhalt abzusuchen sind und wenn sie denn existieren "farblich" zu markieren.

Da ich letztens schon festgestellt habe, dass eine Abfrage über eine "Wenn(Zählenwenn)-Funktion" nur einen ca. 50% Wahrheitswert ausgibt habe ich es mit einem Makro versucht.

Habe diese Makro nicht selbst geschrieben sondern aus einer bereits existierenden Frage hier aus dem Forum entwendet und leicht umgeschrieben.

Wer kann mir helfen das Makro so umzuschreiben, dass es funktionstüchtig wird?

Hier schon mal der Quelltext:

Sub Vergleichen()


Dim Search1 As Range
Dim Search2 As Range
Dim Search3 As Range
Dim lastRowA As Long
Dim lastRowB As Long
Dim lastRowC As Long
lastRowA = Range("A0065536").End(xlUp).Row
lastRowB = Range("B0065536").End(xlUp).Row
lastRowC = Range("C0065536").End(xlUp).Row
For Each Search1 In Range("A2:A" & lastRowA)
For Each Search2 In Range("B2:B" & lastRowB)
For Each Search3 In Range("C2:C" & lastRowC)
If Search1.Text = Search2.Text = Search3.Text Then
Search1.Interior.ColorIndex = 3
Search2.Interior.ColorIndex = 4
Search3.Interior.ColorIndex = 5
End If
Next
Next
Next
End Sub

Und hier der Link zur Tabelle + Makro zum Testen:

http://www.file-upload.net/download-4599710/Vergleich---ber-3-Spalten.xlsm.html


Vielen Dank und Grüße,

Kapa

Answer 1

Hallo,

da du mit Excel 2007 oder 2010 arbeitest, kann ich dir nicht genau sagen ob das richig ist

If Search1.Text = Search2.Text = Search3.Text Then

unter 2003 geht das nicht, da müsste es so sein

If Search1.Text = Search2.Text and Search2.Text = Search3.Text Then

Gruß

Helmut

Answer 2

Hallo Kapa,

teste mal, ob ich Dich richtig verstanden habe.

Sub Vergleichen()
Dim Search1 As Range, Search2 As Range, Search3 As Range
Application.ScreenUpdating = False
For Each Search1 In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
For Each Search2 In Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row)
If Search1.Value = Search2.Value Then
Search1.Interior.ColorIndex = 4
Search2.Interior.ColorIndex = 4
End If
Next Search2
For Each Search3 In Range("C2:C" & Cells(Rows.Count, 3).End(xlUp).Row)
If Search1.Value = Search3.Value Then
Search1.Interior.ColorIndex = 3
Search3.Interior.ColorIndex = 5
End If
Next Search3
Next Search1
Application.ScreenUpdating = True
End Sub

Gruß
Rainer

Answer 3

Guten Morgen Rainer,

habe den von Dir erstellten Quelltext direkt in meine Arbeitstabelle eingefügt.

-> Funk wie verrückt :-)

Vielen, vielen Dank für Deine Unterstützung.

Eine kleine Frage habe ich aber noch.
Wie ist es zu erklären, dass in der ersten Spalte in einigen wenigen Zellen die Farbe "grün" ausgegeben wird und nicht "rot"?

Viele Grüße,

Kapa

Answer 4

Hallo Rainer,

beim genaueren Hinschauen ist mir eine Differenz in der Anzahl der "Gleichteile" je Spalte aufgefallen.

Kann das irgendwie mit unterschiedlichen Längen der Spalteninhalte zu tun haben?

Oder ist dies im Zusammenhang mit den "grün" markierten Zellen in der Spalte A die "rot" markiert sein sollten zu stellen?

Bitte um Rückmeldung.

Vielen Dank und Grüßen,

Kapa

Answer 5

Hallo Kappa,

da mir Deine ursprünglichen Bedingungen nicht ganz klar waren, habe ich den Code noch etwas ergänzt.

Er macht Folgendes:
1. Werte in allen 3 Spalten identisch ---> A=rot, B=grün, C=blau
2. Werte A und B identisch ---> A =grün, B=grün, C=weiß
3. Werte A und C identisch ---> A=blau, C=blau, B=weiß

Option Explicit

Sub Vergleichen()
Dim Search1 As Range, Search2 As Range, Search3 As Range
Application.ScreenUpdating = False
For Each Search1 In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
For Each Search2 In Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row)
If Search1.Value = Search2.Value Then
Search1.Interior.ColorIndex = 4
Search2.Interior.ColorIndex = 4
End If
Next Search2
For Each Search3 In Range("C2:C" & Cells(Rows.Count, 3).End(xlUp).Row)
If Search1.Value = Search3.Value And Search1.Interior.ColorIndex = 4 Then
Search1.Interior.ColorIndex = 3
Search3.Interior.ColorIndex = 5
ElseIf Search1.Value = Search3.Value And Search1.Interior.ColorIndex = xlNone Then
Search1.Interior.ColorIndex = 5
Search3.Interior.ColorIndex = 5
End If
Next Search3
Next Search1
Application.ScreenUpdating = True
End Sub

Gruß
Rainer

Answer 6

Hallo Rainer,

Deine Mühe in aller Ehren.

-> Makro funktioniert wunderbar.

->Alle drei Abfragen sind in Hinblick auf eine Komplettauswertung der gleichen Artikel je Spalte vollkommen realisiert.

Gruß und ein schönes We,

Kapa