Bạn thử:
Sub abc()
Dim c As Range, Rng As Range
Dim LR As Long, LC As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
LC = Cells(1, Columns.Count).End(xlToLeft).Column
Set Rng = Range(Cells(2, 3), Cells(LR, LC))
Application.ScreenUpdating = False
For Each c In Rng
If c.Interior.ColorIndex = 3 Then
c.Value = "B"
End If
If c.Interior.ColorIndex = 6 Then
c.Value = "C"
End If
If c.Interior.ColorIndex = 14 Or c.Interior.ColorIndex = 23 Then
c.Value = "A"
End If
Next c
Application.ScreenUpdating = True
End Sub
Người ta nói rằng:
Tôi đoán người ta muốn thay màu sắc thành ký tự để có thể đếm bằng hàm COUNTIF. Vậy thôi ta viết code đếm màu sắc luôn cho gọn, vì đằng nào cũng viết code, mà code đếm màu sẽ có nhiều ứng dụng hơn so với việc thay màu thành ký tự
Có thể file đó có sẵn, màu đó có sẵn... mà giờ người ta muốn đếm màu nhưng chưa tìm ra cách
Hic bạn này đúng rồi nè, file đó có dữ liệu nhiều năm rồi, các ô tô màu và ghi ký tự khác nhau. Nhưng mình xóa hết ký tự, muốn điền ký tự thống nhất theo màu
Bạn dùng thử code này:
Sub clreplte()
Dim i As Long, n As Long, rng As Range, rng1 As Range, arr
Set rng1 = [c2:id16]
ReDim arr(1 To rng1.Rows.Count, 1 To rng1.Columns.Count)
With CreateObject("scripting.dictionary")
For Each rng In rng1
n = rng.Interior.Color
If Not .exists(n) And n <> 16777215 Then
i = i + 1: .Add n, String(Int((i - 1) / 26) + 1, ChrW$(64 + i))
End If
arr(Range(rng1(1), rng).Rows.Count, Range(rng1(1), rng).Columns.Count) = .Item(n)
Next
End With
[c2].Resize(UBound(arr), UBound(arr, 2)) = arr
End Sub
