1.7k Aufrufe
Gefragt in Tabellenkalkulation von kapa Mitglied (121 Punkte)
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

6 Antworten

0 Punkte
Beantwortet von saarbauer Profi (15.6k Punkte)
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
0 Punkte
Beantwortet von rainberg Profi (14.9k Punkte)
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
0 Punkte
Beantwortet von kapa Mitglied (121 Punkte)
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
0 Punkte
Beantwortet von kapa Mitglied (121 Punkte)
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
0 Punkte
Beantwortet von rainberg Profi (14.9k Punkte)
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
0 Punkte
Beantwortet von kapa Mitglied (121 Punkte)
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
...