Sub CountColor()
Dim Dict, SampleRng As Range, DataRng As Range
Dim LastRw As Long, TotalColor As Long, RArr(), Tmp As Long
With Sheet1
LastRw = .Cells(1000, 2).End(xlUp).Row
Set SampleRng = .Range("H5:J8")
Set DataRng = .Range("C5:E" & LastRw)
Set Dict = CreateObject("Scripting.Dictionary")
For i = 1 To SampleRng.Rows.Count
TotalColor = SampleRng.Cells(i, 1).Interior.Color + _
SampleRng.Cells(i, 2).Interior.Color + _
SampleRng.Cells(i, 3).Interior.Color
Dict.Add TotalColor, i
Next
ReDim RArr(1 To Dict.Count, 1 To 1)
For i = 1 To DataRng.Rows.Count
TotalColor = DataRng.Cells(i, 1).Interior.Color + _
DataRng.Cells(i, 2).Interior.Color + _
DataRng.Cells(i, 3).Interior.Color
Tmp = Dict.Item(TotalColor)
RArr(Tmp, 1) = RArr(Tmp, 1) + 1
Next
.Range("K5").Resize(Dict.Count, 1) = RArr
End With
End Sub
- Đầu tiên cháu cảm ơn hai chú, chú
@ptm0412 chú
@VetMini đã cho chau2 code này, và 2 cách tạo kye cho Dictionary.
- Với bài 1 này. Khi cháu thêm nhiều kiểu nội lực dầm(các giá trị thể hiện ở ô màu nền) ở bảng "NỘI LỰC DẦM HIỆN TẠI" mà không thuộc kiểu ở bảng "NỘI LỰC DẦM MẪU " thì báo lỗi. Điều có nghĩa là các kye tạo ra ở bảng "NỘI LỰC DẦM HIỆN TẠI" không trùng kye "NỘI LỰC DẦM MẪU". Có khi nào nâng cấp code ở 2 Sub có thêm phần code bỏ qua các kye không trùng nhau giữa 2 bảng. Theo cách này hiện cháu chưa đủ kiến thức viết được đoạn code đó. Mong 2 chú giúp cháu phần code đó để cho 2 Sub trên chạy được với cả trường hợp các kye tạo ra ở bảng "NỘI LỰC DẦM HIỆN TẠI" không trùng kye "NỘI LỰC DẦM MẪU".
- Mong được 2 chú giúp cháu với ạ. Cháu xin cảm ơn nhiều ạ!
- Cảm ơn các bạn có xem qua nữa ạ!
(cháu có post ảnh lỗi khi thêm mới dữ liệu, và 2 file excel, trong đó 1 file đã thêm mới dữ liệu,1 file chưa thêm mới)
