Sub test()
K = 2
T = 0
z2 = Cells(Rows.Count, "H").End(xlUp).Row ' AKHARIN SATRE STOON H'
If z2 = 0 Then z2 = 2
Range("H2:j" & z2).Font.ColorIndex = 0
Range("H2:j" & z2).ClearContents ' PAK KARDAN MAHDODEH H & j'
Z1 = Cells(Rows.Count, "A").End(xlUp).Row ' AKHARIN SATRE STOON A'
On Error Resume Next
Dim LIST1 As New Collection
'====================Moshakhas karadan rang hay mojod======='
For Each CELL In Range("A1:E" & Z1)
LIST1.Add CELL.Font.ColorIndex, CStr(CELL.Font.ColorIndex)
Next
'=================sabte rang v tedad rane========================'
For I = 1 To LIST1.Count
Range("H" & K) = "COLOR " & I
Range("H" & K).Font.ColorIndex = LIST1.Item(I)
Range("j" & K) = LIST1.Item(I)
For Each CELL In Range("A1:E" & Z1)
If CELL.Font.ColorIndex = LIST1.Item(I) Then
T = T + 1
End If
Next
Range("I" & K) = T
T = 0
K = K + 1
Next
'======================================'
End Sub
کامنت