Sub doppelte_finden()
With ThisWorkbook.Worksheets("FUHRPARK-ROHDATEN")
Dim int_Spalte As Integer, int_erste_Zeile As Integer, int_letzte_Zeile As Long, int_x As _
Integer
int_erste_Zeile = 3
int_Spalte = 4
int_letzte_Zeile = .Cells(int_erste_Zeile, int_Spalte).End(xlDown).Row
For int_x = int_letzte_Zeile To int_erste_Zeile Step -1
If WorksheetFunction.CountIf(.Range(.Cells(int_erste_Zeile, int_Spalte), .Cells( _
int_letzte_Zeile, int_Spalte)), .Cells(int_x, int_Spalte)) > 1 Then
.Cells(int_x, int_Spalte).Interior.ColorIndex = 3
End If
Next int_x
End With
End Sub
Sub doppelte_finden()
With ThisWorkbook.Worksheets("FUHRPARK-ROHDATEN")
Dim int_Spalte As Integer, int_erste_Zeile As Integer, int_letzte_Zeile As Long, int_x As _
Integer
int_erste_Zeile = 3
int_x = int_erste_Zeile - 1
int_Spalte = 4
TinA = 0
Theme = 1
int_letzte_Zeile = .Cells(int_erste_Zeile, int_Spalte).End(xlDown).Row
Do
Do
int_x = int_x + 1
With .Range(.Cells(int_x, 1), .Cells(int_x, 9)).Interior
.ThemeColor = Theme
.TintAndShade = TinA
End With
Loop While .Cells(int_x, int_Spalte) = .Cells(int_x + 1, int_Spalte)
If TinA = 0 Then
TinA = -9.99481185338908E-02: Theme = xlThemeColorDark2
Else
TinA = 0: Theme = 1
End If
Loop While .Cells(int_x + 1, int_Spalte) ""
End With
End Sub
Sub doppelte_finden()
With ThisWorkbook.Worksheets("FUHRPARK-ROHDATEN")
Dim int_Spalte As Integer, int_erste_Zeile As Integer, int_letzte_Zeile As Long, int_x As _
Integer
int_erste_Zeile = 3
int_x = int_erste_Zeile - 1
int_Spalte = 4
TinA = 0
Theme = 1
Do ' hier ist die Hauptschleife die solange läuft bis in der Spalte 4 kein Wert mehr steht
Do ' hier die neben schleife die .ThemeColor und .TintAndShade ändert
int_x = int_x + 1
With .Range(.Cells(int_x, 1), .Cells(int_x, 9)).Interior
.ThemeColor = Theme
.TintAndShade = TinA
End With
Loop While .Cells(int_x, int_Spalte) = .Cells(int_x + 1, int_Spalte) ' nebenschleife _
wird beendet wenn eine zeile darunter nicht mehr der selbe wert steht
If TinA = 0 Then ' hier werden die Farben geändert
TinA = -9.99481185338908E-02: Theme = xlThemeColorDark2
Else
TinA = 0: Theme = 1
End If
Loop While .Cells(int_x + 1, int_Spalte) ""
End With
End Sub
.Rows(int_x).Interior.ColorIndex = 3
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen