1. Đăng sai box
Có cách xài VBA, ưng không thì bảo?
Bạn dùng thử code sau:
Sub RangeColor()
Dim rng As Range
Dim rCell As Range
Dim Dic As Object
Dim ColorValue As Integer
On Error Resume Next
Set rng = Application.InputBox(Prompt:="Select a range", Type:=8)
On Error GoTo 0
If rng Is Nothing Then Exit Sub
Set Dic = CreateObject("Scripting.Dictionary")
For Each rCell In rng
If Not IsEmpty(rCell) Then
If Not Dic.Exists(rCell.Value) Then
ColorValue = Dic.Count + 3
'---> Neu muon mau random, moi lan chay ra mot mau khac nhau
'ColorValue = Int(50 * Rnd)
Dic.Add rCell.Value, ColorValue
End If
rCell.Interior.ColorIndex = Dic(rCell.Value)
End If
Next rCell
End SubSub ToMauTheoTriTrung()
Dim Rng As Range, Cls As Range, cRg As Range, sRng As Range, WF As Object
Dim W As Integer: Dim MyAdd As String, StrC As String
Set Rng = Sheet1.UsedRange: Rng.Interior.ColorIndex = 2
Set WF = Application.WorksheetFunction
For Each Cls In Rng
If Cls.Value <> "" And WF.CountIf(Rng, Cls.Value) > 1 _
And Cls.Interior.ColorIndex < 9 Then
Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
If Not sRng Is Nothing Then
MyAdd = sRng.Address
Do
If cRg Is Nothing Then
Set cRg = sRng
Else
Set cRg = Union(cRg, sRng)
End If
Set sRng = Rng.FindNext(sRng)
Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
If cRg.Cells.Count > 2 Then
cRg.Interior.ColorIndex = 34 + (Asc(Cls.Value) Mod 10)
Set cRg = Nothing: W = W + 1
End If
End If
End If
Next Cls
' MsgBox W '
End Sub
