Office: (Office 2010) Doppelte Werte in Zeile/Matrix finde

Hallo,

wieder einmal bin ich auf die Hilfe von euch angewiesen.

Ich habe eine Matrix, in welcher ich jede Zeile separat prüfen möchte ob Werte mehrmals vorkommen, die Zellen sollen darauf hin farbig markiert werden.
Es soll kein Abgleich mit den ganzen Zeilen erfolgen, d.h. in den Zeilen ober- bzw. unterhalb kann der Wert ruhig vorkommen.

Ich habe zwar einen schicken Makro gefunden, nur dieser prüft mir die Zeilen einzeln, so dass ich jedes mal die Zeile anklicken muss, welche geprüft werden soll. Ich habe leider keine Ahnung wie ich den Makro umschreiben muss.
Vielleicht hat aber jemand auch eine andere Idee.

A B C D E
Zeile1: 1 4 2 4 1
Zeile2: 2 1 2 4 3

etc.

Vielen Dank für eure Hilfe
BG

Marcus

Anbei der Makro:


Sub MehrfachEintraege()

Dim rngRow As Range, colStart, colEnd, rowNum, actCell, i, numCol, valCell

'2 hier Deine Spaltennummern eintragen > A=1, B=2, C=3....
colStart = 10 'linkes Ende des zu prüfenden Bereichs
colEnd = 29 'rechtes Ende
'aktive Zeilennummer
rowNum = ActiveCell.Row
'zu prüfenden Bereich vermessen
Set rngRow = ActiveSheet.Range(Cells(rowNum, colStart), Cells(rowNum, colEnd))
'alte Farben zurücksetzen
rngRow.Cells.Interior.ColorIndex = xlColorIndexNone
Cells(rowNum, colStart).Select

'prüft nacheinander alle Zellen
For i = 1 To rngRow.Columns.Count
numCol = ActiveCell.Offset(0, i - 1).Column
valCell = ActiveCell.Offset(0, i - 1).Value
'von zu prüfender Zelle aus weiter prüfen
For Each actCell In rngRow.Cells
'wenn Zelle weiter rechts ist, und gleicher Wert hat,
'und keine Farbe hat, und nicht leer ist
If actCell.Column > numCol And _
actCell.Value = valCell And _
actCell.Interior.ColorIndex = xlColorIndexNone And _
actCell.Value <> "" Then
actCell.Interior.ColorIndex = i + 2
End If
Next
Next i

End Sub

 

Doppelte markieren

Hallo,

eigentlich reicht da eine bedingte Formatierung, es sei denn du willst jeder zelle eine andere Farbe zuweisen.

Als Makro:

Code:

Option Explicit

Sub MehrfachEintraege()

Dim rng As Range
Dim lofRow As Long
Dim lolRow As Long
Dim strfCol As String
Dim strlCol As String
Dim lofCol As Long
Dim lolCol As Long
Dim loA As Long
Dim loB As Long
Dim loC As Long
Dim loX As Long
loC = 3
lofRow = CLng(InputBox("Startzeile eingeben"))
lolRow = CLng(InputBox("letzte Zeile eingeben"))
strfCol = InputBox("erste Spalte eingeben (Buchstaben!)")
strlCol = InputBox("letzte Spalte eingeben (Buchstaben!)")
lofCol = Range(strfCol & 1).Column
lolCol = Range(strlCol & 1).Column
Set rng = Range(strfCol & lofRow & ":" & strlCol & lolRow)
rng.Font.ColorIndex = 1
For loA = lofRow To lolRow
    Set rng = Range(Cells(loA, lofCol), Cells(loA, lolCol))
        For loB = lofCol To lolCol - 1
            If Cells(loA, loB).Font.ColorIndex = 1 And Cells(loA, loB) <> "" Then
                If Application.CountIf(rng, Cells(loA, loB)) > 1 Then
                    Cells(loA, loB).Font.ColorIndex = loC
                    loX = Application.Match(Cells(loA, loB), Range(Cells(loA, loB + 1), Cells(loA, lolCol)), 0)
                    Cells(loA, loB + loX).Font.ColorIndex = loC
                    loC = loC + 1
                End If
            End If
        Next
Next
End Sub

Gruß

Edgar

 

Hallo Edgar,

vielen vielen Dank für deine Hilfe. Bei der bedingten Formatierung musse ich auch jede Zeile einzeln nehmen sobald ich mehre Zeilen auswähle markiert er mir die doppelten Werte zeilenunabhängig - außer du kennst ein Trick wie es so geht dann würde ich auch die bedingte Formatierung nehmen.

Nun zu deinem Makro: Genial genau das was ich brauche, wirklich super vielen Dank. Eine Bitte habe ich jedoch noch kannst du den Makro bitte so umschreiben, das anstatt die Schrift, die Zellen farbig werden - dann wärst du mein persönlicher Held. :)

 

Hallo,

noch ein kleiner Nachtrag. Ich habe ein Datei mit knapp 900.000Zeilen :). Wenn ich dein Makro laufen lasse kommt leider die Meldung "Index außerhalb des gültigen Bereichs". was muss ich ändern damit dein Makro hier läuft. Sollte es an den Farben liegen, können diese ruhig begrenzt werden auf die Zeile, Spalten kann z.B. Rot ruhig tausende male vorkommen.

LG

Marcus

 

Hallo!

Bei der Bedingten Formatierung ist es nur eine Frage der korrekten Adressierung. Dann aber ist es leicht:

[TABLE]
<colgroup><col style="font-weight:bold; width:30px; "><col style="width:80px;"><col style="width:80px;"><col style="width:80px;"><col style="width:80px;"><col style="width:80px;"><col style="width:80px;"></colgroup><tbody>[TR="bgcolor: #cacaca"]
[TD] [/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[/TR]
[TR]
[TD="bgcolor: #cacaca, align: center"]1[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD="bgcolor: #cacaca, align: center"]2[/TD]
[TD] [/TD]
[TD="bgcolor: #ff0000, align: right"]1[/TD]
[TD="bgcolor: #ff0000, align: right"]4[/TD]
[TD="align: right"]2[/TD]
[TD="bgcolor: #ff0000, align: right"]4[/TD]
[TD="bgcolor: #ff0000, align: right"]1[/TD]
[/TR]
[TR]
[TD="bgcolor: #cacaca, align: center"]3[/TD]
[TD] [/TD]
[TD="bgcolor: #ff0000, align: right"]2[/TD]
[TD="align: right"]1[/TD]
[TD="bgcolor: #ff0000, align: right"]2[/TD]
[TD="align: right"]4[/TD]
[TD="align: right"]3[/TD]
[/TR]
</tbody>[/TABLE]

[TABLE]
<tbody>[TR]
[TD]Bedingte Formatierungen der Tabelle[/TD]
[/TR]
[TR]
[TD][TABLE]
<tbody>[TR]
[TD]Zelle[/TD]
[TD]Nr.: / Bedingung[/TD]
[TD]Format[/TD]
[/TR]
[TR]
[TD]B2[/TD]
[TD]1. / Formel ist =ZÄHLENWENN($B2:$F2;B2)>1[/TD]
[TD="bgcolor: #ff0000"]Abc[/TD]
[/TR]
[TR]
[TD]C2[/TD]
[TD]1. / Formel ist =ZÄHLENWENN($B2:$F2;B2)>1[/TD]
[TD="bgcolor: #ff0000"]Abc[/TD]
[/TR]
[TR]
[TD]D2[/TD]
[TD]1. / Formel ist =ZÄHLENWENN($B2:$F2;B2)>1[/TD]
[TD="bgcolor: #ff0000"]Abc[/TD]
[/TR]
[TR]
[TD]E2[/TD]
[TD]1. / Formel ist =ZÄHLENWENN($B2:$F2;B2)>1[/TD]
[TD="bgcolor: #ff0000"]Abc[/TD]
[/TR]
[TR]
[TD]F2[/TD]
[TD]1. / Formel ist =ZÄHLENWENN($B2:$F2;B2)>1[/TD]
[TD="bgcolor: #ff0000"]Abc[/TD]
[/TR]
[TR]
[TD]B3[/TD]
[TD]1. / Formel ist =ZÄHLENWENN($B2:$F2;B2)>1[/TD]
[TD="bgcolor: #ff0000"]Abc[/TD]
[/TR]
[TR]
[TD]C3[/TD]
[TD]1. / Formel ist =ZÄHLENWENN($B2:$F2;B2)>1[/TD]
[TD="bgcolor: #ff0000"]Abc[/TD]
[/TR]
[TR]
[TD]D3[/TD]
[TD]1. / Formel ist =ZÄHLENWENN($B2:$F2;B2)>1[/TD]
[TD="bgcolor: #ff0000"]Abc[/TD]
[/TR]
[TR]
[TD]E3[/TD]
[TD]1. / Formel ist =ZÄHLENWENN($B2:$F2;B2)>1[/TD]
[TD="bgcolor: #ff0000"]Abc[/TD]
[/TR]
[TR]
[TD]F3[/TD]
[TD]1. / Formel ist =ZÄHLENWENN($B2:$F2;B2)>1[/TD]
[TD="bgcolor: #ff0000"]Abc[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8


(Angezeigt wird hier leider nur die Formel für B2.)

 

Hallo,

bei 900000 Zeilen reicht die Farbpalette nicht mehr aus. Also würde ich die Zahl der Farben auf ein kleineres Maß reduzieren.

Code:

Option Explicit

Sub MehrfachEintraege()

Dim rng As Range
Dim lofRow As Long
Dim lolRow As Long
Dim strfCol As String
Dim strlCol As String
Dim lofCol As Long
Dim lolCol As Long
Dim loA As Long
Dim loB As Long
Dim loC As Long
Dim loX As Long
loC = 3
lofRow = CLng(InputBox("Startzeile eingeben"))
lolRow = CLng(InputBox("letzte Zeile eingeben"))
strfCol = InputBox("erste Spalte eingeben (Buchstaben!)")
strlCol = InputBox("letzte Spalte eingeben (Buchstaben!)")
lofCol = Range(strfCol & 1).Column
lolCol = Range(strlCol & 1).Column
Set rng = Range(strfCol & lofRow & ":" & strlCol & lolRow)
rng.Interior.ColorIndex = 1
For loA = lofRow To lolRow
    Set rng = Range(Cells(loA, lofCol), Cells(loA, lolCol))
        For loB = lofCol To lolCol - 1
            If Cells(loA, loB).Interior.ColorIndex = 1 And Cells(loA, loB) <> "" Then
                If Application.CountIf(rng, Cells(loA, loB)) > 1 Then
                    Cells(loA, loB).Interior.ColorIndex = loC
                    loX = Application.Match(Cells(loA, loB), Range(Cells(loA, loB + 1), Cells(loA, lolCol)), 0)
                    Cells(loA, loB + loX).Interior.ColorIndex = loC
                    loC = loC + 1
                    if loC=11 then loC=3
                End If
            End If
        Next
Next
End Sub