VBA auf Bereich ändern
09.10.2017 14:55:45
Blue
ich weiß einige im Forum ändern ungern fremde Makros um, aber ich komme leider nicht alleine weiter.
Daher hoffe ich das jemand von euch mit folgendes Makro was auf Spalte C bezogen ist.
Auf den Bereich B4 bis U12 ändern könnte.
Sub Doppelte_markieren_Spalte_C()
Dim lngZeile As Long
Dim lngEnde As Long
Dim strValue As String
Dim objDupList As Object
Dim arrFarben As Variant
Dim intFarben As Integer
arrFarben = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
Set objDupList = CreateObject("Scripting.Dictionary")
lngEnde = Cells(Rows.Count, 3).End(xlUp).Row
Columns("C:C").Interior.ColorIndex = xlNone
For lngZeile = 1 To lngEnde
strValue = Cells(lngZeile, "C").Text
If strValue "" Then
If Application.CountIf(Range("C1:C" & lngEnde), strValue) > 1 Then
If objDupList.Exists(strValue) Then
Cells(lngZeile, "C").Interior.ColorIndex = objDupList.Item(strValue)
Else
Cells(lngZeile, "C").Interior.ColorIndex = arrFarben(intFarben)
objDupList.Add strValue, arrFarben(intFarben)
intFarben = intFarben + 1
If intFarben > UBound(arrFarben) Then intFarben = 0
End If
End If
End If
Next
End Sub
mfg Blue Bird
Anzeige