Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Bewerten Sie hier bitte das Excel-Portal

Home Zurück Vor

Download Beispiel-Arbeitsmappe

Thema

Doppelte Datensätze farblich markieren und auflisten

Gruppe

Markieren

Problem

Wie kann ich doppelte Datensätze in Tabelle1 farblich markieren und in Tabelle2 übertragen?

Lösung

Geben Sie den nachfolgenden Code in ein Standardmodul ein und weisen Sie ihn einer Schaltfläche zu.

StandardModule: basMain

Sub Vergleich()
   Dim iRowA As Integer, iRowB As Integer
   Dim iCol As Integer, iColor As Integer
   Dim iRowC As Integer
   Dim bln As Boolean, blnColor As Boolean
   iRowA = 2
   iColor = 2
   Do Until IsEmpty(Cells(iRowA, 1))
      iRowB = iRowA + 1
      Do Until IsEmpty(Cells(iRowB, 1))
         For iCol = 1 To 3
            If Cells(iRowA, iCol) <> Cells(iRowB, iCol) Then
               bln = True
               Exit For
            End If
         Next iCol
         If bln = False Then
            If blnColor = False Then
               iColor = iColor + 1
            End If
            If Cells(iRowB, 1).Interior.ColorIndex = _
               xlColorIndexNone Then
               If Cells(iRowA, 1).Interior.ColorIndex = _
                  xlColorIndexNone Then
                  With Worksheets(3)
                     iRowC = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                     .Range(.Cells(iRowC, 1), .Cells(iRowC, 3)).Value = _
                        Range(Cells(iRowB, 1), Cells(iRowB, 3)).Value
                  End With
               End If
               Range(Cells(iRowA, 1), Cells(iRowA, 3)). _
                  Interior.ColorIndex = iColor
               Range(Cells(iRowB, 1), Cells(iRowB, 3)). _
                  Interior.ColorIndex = iColor
               blnColor = True
            End If
         End If
         iRowB = iRowB + 1
         bln = False
      Loop
      blnColor = False
      iRowA = iRowA + 1
   Loop
End Sub