Supportnet / Forum / Tabellenkalkulation
Zwei Bereiche vergleichen
Frage
Hallo,
ich möchte zwei Tabellenbereiche miteinander vergleichen.
Bereich1 = A2:G12
Bereich2 = A15:F18
Gleiche Zellinhalte sollten in Bereich1 mit der Farbe ROT hinterlegt werden.
Bitte nur VBA
Vielen Dank im voraus
MfG
Tom
Antwort 1 von Event
Hallo
Hoffe Du kommst klar...
Gruß
Private Sub CommandButton1_Click()
Dim bereich1 As Range, bereich2 As Range, zelle, zellen
Set bereich1 = Range("A2:G12")
Set bereich2 = Range("A15:F18")
For Each zellen In bereich1
For Each zelle In bereich2
If zellen.Value = zelle.Value And zellen.Value <> "" Then
zellen.Font.Color = RGB(255, 0, 0)
Exit For
Else: zellen.Font.ColorIndex = xlColorIndexAutomatic
End If
Next
Next
End Sub
Hoffe Du kommst klar...
Gruß
Antwort 2 von Tom1000
Hallo Event,
klappt Supi. Danke schön.
Hätte noch eine Zusatzfrage:
Was muss ich an deinem Code verändern, damit er die gleichen Zellinhalte auf einem neuen Blatt untereinander listet. Also von A1 beginnend bzw. die erste freie Zelle in Spalte A, jede Übereinstimmung in eine Zeile (A2, A3......)
Wäre super nett, wenn du mir nochmal helfen würdest
Vielen Dank
MfG
Tom
klappt Supi. Danke schön.
Hätte noch eine Zusatzfrage:
Was muss ich an deinem Code verändern, damit er die gleichen Zellinhalte auf einem neuen Blatt untereinander listet. Also von A1 beginnend bzw. die erste freie Zelle in Spalte A, jede Übereinstimmung in eine Zeile (A2, A3......)
Wäre super nett, wenn du mir nochmal helfen würdest
Vielen Dank
MfG
Tom
Antwort 3 von Event
Hallo
Hoffe Du kommst damit klar...
Gruß
Private Sub CommandButton1_Click()
Dim bereich1 As Range, bereich2 As Range, zelle, zellen
Set bereich1 = Range("A2:G12")
Set bereich2 = Range("A15:F18")
For Each zellen In bereich1
For Each zelle In bereich2
If zellen.Value = zelle.Value And zellen.Value <> "" Then
zellen.Font.Color = RGB(255, 0, 0)
zellen.Copy
Sheets("Tabelle2").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial (xlValues)
Exit For
Else: zellen.Font.ColorIndex = xlColorIndexAutomatic
End If
Next
Next
End Sub
Hoffe Du kommst damit klar...
Gruß
Antwort 4 von Tom1000
Hallo Event,
nochmals meinen herzlichsten Dank.
Sorry, jetzt muss ich nochmal nerven:
Warum wird die Auflistung in Tabelle2 erst ab A2 gestartet, obwohl A1 leer ist ?
Danke u. Gruss
Tom
nochmals meinen herzlichsten Dank.
Sorry, jetzt muss ich nochmal nerven:
Warum wird die Auflistung in Tabelle2 erst ab A2 gestartet, obwohl A1 leer ist ?
Danke u. Gruss
Tom
Antwort 5 von Event
Hallo
Schau Dir dazu das mal an, und versuch´ Dein Glück hiermit...
Gruß
Schau Dir dazu das mal an, und versuch´ Dein Glück hiermit...
Private Sub CommandButton1_Click()
Dim bereich1 As Range, bereich2 As Range, zelle, zellen
Set bereich1 = Range("A2:G12")
Set bereich2 = Range("A15:F18")
For Each zellen In bereich1
For Each zelle In bereich2
If zellen.Value = zelle.Value And zellen.Value <> "" Then
zellen.Font.Color = RGB(255, 0, 0)
zellen.Copy
Sheets("Tabelle2").Range("A1:A65535").SpecialCells(xlBlanks).Areas(1).Cells(1).PasteSpecial (xlValues)
Exit For
Else: zellen.Font.ColorIndex = xlColorIndexAutomatic
End If
Next
Next
End Sub
Gruß
Antwort 6 von Tom1000
Hallo Event,
bei deinem letzten Vorschlag bekomme ich die Meldung:
Keine Zellen gefunden
In dieser Zeile des Codes kommt die Meldung:
Sheets("Tabelle2").Range("A1:A65535").SpecialCells(xlBlanks).Areas(1).Cells(1).PasteSpecial (xlValues)
Die Zellen sind aber absolut Leer. Keine Formatierungen oder ähnliches.
Ich nehme deinen vorletzten Vorschlag. Der reicht mir vollkommen.
Also, vielen Dank nochmal für deine Geduld u. deine Lösungen
Gruss
Tom
bei deinem letzten Vorschlag bekomme ich die Meldung:
Keine Zellen gefunden
In dieser Zeile des Codes kommt die Meldung:
Sheets("Tabelle2").Range("A1:A65535").SpecialCells(xlBlanks).Areas(1).Cells(1).PasteSpecial (xlValues)
Die Zellen sind aber absolut Leer. Keine Formatierungen oder ähnliches.
Ich nehme deinen vorletzten Vorschlag. Der reicht mir vollkommen.
Also, vielen Dank nochmal für deine Geduld u. deine Lösungen
Gruss
Tom