Excel: Vergleiche Spalte A mit Spalte B und hebe gleiche Werte farblich hervor

[Janush]

Das hat den Hintergrund, da ich in der Buchhaltung Summen- und Saldenlisten und Kontenblätter abgleichen muss.

Dude, bastelst du da immer noch dran rum? Der letzte Thread hat ja einfach so geendet, ohne Ergebnis.

Hier ist der Code für deine Beispiel-Tabelle, ohne lästige Formeln, oder noch schlimmer...bedingte Formatierung. Ich wollte das nur mal so in den Raum stellen. Wie gesagt, ich würde den ganzen Prozess automatisieren.

Option Explicit

Public Sub Abgleich()

Dim i       As Integer
Dim j       As Integer

With Sheet1

    For i = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
   
        For j = 1 To .Cells(.Rows.Count, "C").End(xlUp).Row
           
            If Not .Cells(j, 3).Interior.ThemeColor = xlThemeColorAccent6 Then
           
                If .Cells(i, 1).Value = .Cells(j, 3).Value Then
                   
                    SetBG .Cells(i, 1)
                    SetBG .Cells(j, 3)
                   
                    Exit For
               
                End If
           
            End If
           
        Next j
       
    Next i

End With

End Sub

Public Sub Zurueck()

ClearBG Sheet1.Range("A:C")

End Sub

Private Sub SetBG(ByRef r As Range)

With r.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorAccent6
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With
   
End Sub

Private Sub ClearBG(ByRef r As Range)

With r.Interior
    .Pattern = xlNone
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With

End Sub

Wenn du die Subs Abgleich und Zurück jeweils auf einen Knopf legst, kannst du es immer wieder beliebig durchlaufen lassen. Das ist jetzt nur mal eben schnell runter getippt...kann bestimmt noch optimiert/erweitert werden :-)

Edit: Ich habe das eben nochmal als fertige ACHTUNG .xlsm hochgeladen. Wenn du dich traust, kannst du die nehmen :-)

 

[tollertyp]

Hier ist der Code für deine Beispiel-Tabelle, ohne lästige Formeln, oder noch schlimmer...bedingte Formatierung. Ich wollte das nur mal so in den Raum stellen.

Stimmt, VBA ist viel weniger lästig.

(Wer Ironie oder Sarkasmus findet hat den Beitrag verstanden)

 

[Janush]

Ich wollte nur VBA als zusätzliche Lösung in den Raum stellen und nicht, dass Formeln per se schlecht sind.

Bei bedingter Formatierung bin ich mir da nicht so sicher, das muss einfach irgendwann kaputt gehen.

 

[tollertyp]

Also ich habe auch über VBA nachgedacht, und ja, beide Varianten haben ihre Vor- und Nachteile.
Ja, die Formeln werden irgendwann "kaputt" gehen (falsche Bezüge usw), aber auch das VBA (wenn auch robuster) braucht vielleicht mal Pflege.

 

[batista0102]

Nur um sicher zu gehen: wenn in beiden Spalten gleiche Zahlen vorkommen, dann sollen in Spalte A diese Zahlen so oft markiert werden, wie sie in Spalte B vorkommen? ZB: in A und B kommen jeweils die 1 und die 2 vor. Die 1 steht in Spalte B 1mal, in Spalte A 4mal = nur eine 1 in Spalte A markieren.
Die 2 steht in Spalte B 3 mal, in Spalte A 5 mal = 3mal die 2 in Spalte A markieren?

Guten Morgen,

genau so meinte ich das. Angenommen ich habe in Spalte A die 1 3 mal und in Spalte B die 1 nur 1 mal. So soll die 1 in Spalte auch nur 1 mal markiert werden. Das hat den Hintergrund wenn ich ein Kontoblatt abstimme und in meinem Kontoblatt kommt der Betrag zB. 100 EUR nur einmal vor und im anderen Kontoblatt 3 mal, dann markiert mir Excel ja alle Zeilen und so finde ich ja die Differenz nicht.

 

[Janush]

Also ich habe auch über VBA nachgedacht, und ja, beide Varianten haben ihre Vor- und Nachteile.
Ja, die Formeln werden irgendwann "kaputt" gehen (falsche Bezüge usw), aber auch das VBA (wenn auch robuster) braucht vielleicht mal Pflege.

VBA hat ja den Vorteil, dass man nichts anpassen muss so lange sich der Prozess nicht ändert. Man muss natürlich schauen, dass man alle möglichen Fehler irgendwie abfängt, in meinem Code fehlt zum Beispiel noch etwas für leere Zellen.
Man kann aber Werte einfach per Copy&Paste einfügen, oder irgendwelche Zeilen löschen und es funktioniert immer noch.

Bedingte Formatierung macht Sinn in einem unveränderlichen System in welchem der Benutzer Daten per Hand eingibt. Z.B. ein Kalenderblatt, oder so. Sobald man aber anfängt Zeilen einzufügen, oder zu löschen ist es nur eine Frage der Zeit bis es nicht mehr stimmt. Und dann sieht man noch nicht einmal wo die bedingte Formatierung eigentlich drüber liegt. Für einen Saldencheckt denkbar ungünstig...ist der Wert nicht vorhanden, oder ist die Zelle zufällig nicht formatiert?!

Aber ich muss sagen, ich bin gespannt, wie die Formellösung für dieses Problem aussehen wird :-)

 

[batista0102]

Dude, bastelst du da immer noch dran rum? Der letzte Thread hat ja einfach so geendet, ohne Ergebnis.

Hier ist der Code für deine Beispiel-Tabelle, ohne lästige Formeln, oder noch schlimmer...bedingte Formatierung. Ich wollte das nur mal so in den Raum stellen. Wie gesagt, ich würde den ganzen Prozess automatisieren.

Option Explicit

Public Sub Abgleich()

Dim i       As Integer
Dim j       As Integer

With Sheet1

    For i = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
  
        For j = 1 To .Cells(.Rows.Count, "C").End(xlUp).Row
          
            If Not .Cells(j, 3).Interior.ThemeColor = xlThemeColorAccent6 Then
          
                If .Cells(i, 1).Value = .Cells(j, 3).Value Then
                  
                    SetBG .Cells(i, 1)
                    SetBG .Cells(j, 3)
                  
                    Exit For
              
                End If
          
            End If
          
        Next j
      
    Next i

End With

End Sub

Public Sub Zurueck()

ClearBG Sheet1.Range("A:C")

End Sub

Private Sub SetBG(ByRef r As Range)

With r.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorAccent6
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With
  
End Sub

Private Sub ClearBG(ByRef r As Range)

With r.Interior
    .Pattern = xlNone
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With

End Sub

Wenn du die Subs Abgleich und Zurück jeweils auf einen Knopf legst, kannst du es immer wieder beliebig durchlaufen lassen. Das ist jetzt nur mal eben schnell runter getippt...kann bestimmt noch optimiert/erweitert werden :-)

Edit: Ich habe das eben nochmal als fertige ACHTUNG .xlsm hochgeladen. Wenn du dich traust, kannst du die nehmen :-)

Mit VBA kenne ich mich leider überhaupt nicht aus. Ich habe im Netz gesehen das ich mit Alt+F11 in den Editor komme. Nun dann wäre die Frage wo müsste ich diesen Code dann eingeben und wird das Ergebnis des Codes gleich auf meine Tabellen angewant bzw. muss ich dann noch etwas machen?

Vielen Dank.

 

[Janush]

Also entweder nimmst du das Sheet, welches ich hoch geladen habe (das würde ich aber nicht empfehlen...da ist zwar nichts gefährliches drin, aber dafür hast du nur mein Wort :-) ), oder du gehst in den Editor wo du auf der linken Seite eine Übersicht über alle deine Excelobjekte findest. Wie eine Ordnerstruktur.

Dort klickst du mit der rechten Maustaste irgendwo drauf und wählst Modul einfügen aus. Jetzt sollte sich ein Fenster öffnen und da fügst du den Kompletten Code ein. Du hast jetzt also ein Modul wo der Code drin steht.

Zur Probe kannst du jetzt einfach mal auf den kleinen Play Button oben in der Toolbar klicken und schauen, ob sich etwas getan hat, oder ob eine Fehlermeldung kommt.

Wenn das funktioniert, dann fügst du dir einen Knopf auf deinem Sheet ein und verknüpfst das Makro damit.

 

[tollertyp]

Also aufgrund deiner weiteren Ausführungen, dass jeder Wert eine eigene Übereinstimmung braucht, fällt die bdingte Formatierung aus meiner Sicht raus und es bleibt nur VBA übrig.

Damit das VBA aber wartbar bleibt, sollte man es auch entsprechend schreiben... vor allem die Mischung mal aus "A" und mal 1, mal "C" und 3... wie oft muss man die 3 zu einer 4 ändern, damit Spalte D genommen wird? Ach und das "C" auch zu "D".

Ich würde es direkt mal in diese Richtung refaktorisieren:

Option Explicit

Private Const SHEET_NAME As String = "Tabelle1"
Private Const COLUMN_1 As Integer = 1
Private Const COLUMN_2 As Integer = 4
Private Const FIRST_ROW As Integer = 1


Public Sub Abgleich()
    Dim row1, row2 As Integer
  
    ResetSheet
  
    With Worksheets(SHEET_NAME)
  
        For row1 = FIRST_ROW To .Cells(.Rows.Count, COLUMN_1).End(xlUp).Row
          
            For row2 = FIRST_ROW To .Cells(.Rows.Count, COLUMN_2).End(xlUp).Row
              
                If .Cells(row2, COLUMN_2).Interior.Pattern = xlNone Then
                  
                    If .Cells(row1, COLUMN_1).Value = .Cells(row2, COLUMN_2).Value Then
                      
                        SetBG .Cells(row1,COLUMN_1)
                        SetBG .Cells(row2, COLUMN_2)
                    
                        Exit For
                 
                    End If
             
                End If
             
            Next row2
         
        Next row1
  
  
    End With
  
  
End Sub

Public Sub ResetSheet()
    ClearBG Worksheets(SHEET_NAME).Columns(COLUMN_1)
    ClearBG Worksheets(SHEET_NAME).Columns(COLUMN_2)
End Sub

Private Sub SetBG(ByRef r As Range)
    With r.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub

Private Sub ClearBG(ByRef r As Range)
    With r.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub

Das ganze würde sich sogar noch pimpen lassen, dass bei Änderung der Werte auch die Farben automatisch aktualisiert werden.

In einer relativ naiven Variante:

Private Sub Worksheet_Change(ByVal Target As Range)
    With Worksheets(SHEET_NAME)
        If Intersect(Target, .Columns(COLUMN_1)) Is Nothing And Intersect(Target, .Columns(COLUMN_2)) Is Nothing Then Exit Sub
    End With
    Abgleich
End Sub

 

[Janush]

Sieht doch gut aus :-)