Zeilen markieren wenn doppelt

• Zeilen markieren wenn doppelt von Martin vom 25.02.2005 07:59:22
• AW: Zeilen markieren wenn doppelt - von Boris am 25.02.2005 09:24:27
  • danke für schnelle Hilfe! o.T. - von Martin am 25.02.2005 09:35:05
• AW: Zeilen markieren wenn doppelt - von Harald E am 25.02.2005 09:30:11
  • danke für schnelle Hilfe! o.T. - von Martin am 25.02.2005 09:34:16

Betrifft: Zeilen markieren wenn doppelt von: Martin
Geschrieben am: 25.02.2005 07:59:22

Hallo und guten morgen!

Ich suche nach einer Möglichkeit per VBA Zeilen einer Tabelle zu unterlegen, wenn sie in mehrern Spalten mit einer anderen übereinstimmen, sprich, wenn sie doppelt sind.

Vielen Dank

Betrifft: AW: Zeilen markieren wenn doppelt von: Boris
Geschrieben am: 25.02.2005 09:24:27

Hi Martin,

hier mal ein Beispiel für die Zeilen 1 bis 100, wobei die Spalten A, C und D übereinstimmen müssen (also mehr als 1 mal vorkommen), damit die Zeile markiert wird.

Option Explicit

Sub doppelte_markieren()
Dim i As Long, s As String
For i = 1 To 100 'Zeilen 1 bis 100
    s = "sumproduct((A1:A100=" & Cells(i, "A").Address & ")*(C1:C100=" & Cells(i, "C").Address & ")*(D1:D100=" & Cells(i, "D").Address & "))"
    Rows(i).Interior.ColorIndex = IIf(Evaluate(s) > 1, 6, xlNone)
Next i
End Sub

Grüße Boris




Betrifft: danke für schnelle Hilfe! o.T. von: Martin
Geschrieben am: 25.02.2005 09:35:05






Betrifft: AW: Zeilen markieren wenn doppelt von: Harald E
Geschrieben am: 25.02.2005 09:30:11

Hallo Martin,

aus dem Archiv und ungetestet. Doppelte werden markiert und laut Angabe auch in Tabelle 2 aufgelistet.

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

Gruß
harald




Betrifft: danke für schnelle Hilfe! o.T. von: Martin
Geschrieben am: 25.02.2005 09:34:16

Beiträge aus den Excel-Beispielen zum Thema "Zeilen markieren wenn doppelt"