Tìm kiểu màu trong danh sách.

Liên hệ QC

Cô Bé Dễ Thương

Thành viên thường trực
Tham gia
30/9/16
Bài viết
223
Được thích
48
Giới tính
Nữ
20210208_144454.jpg
Bài này em làm mãi không được ạ. Các thầy và anh chị giúp em với.
 

File đính kèm

  • Dammau1.xlsx
    9.9 KB · Đọc: 18
Lần chỉnh sửa cuối:
Bác lài bồi cho một chùy như vậy nữa. Ác
Không nên viết tiêu đề gợi cảm xúc
Chạy code sau, sau đó CountIf với F là sum C, D, E
Mã:
Sub CellColor()
For Each cel In Union(Range("h5:j8"), Range("C5:E14"))
    cel.Value = cel.Interior.Color
    cel.Font.Color = cel.Value
Next
End Sub
1612772206616.png
 
Upvote 0
Không nên viết tiêu đề gợi cảm xúc
Chạy code sau, sau đó CountIf với F là sum C, D, E
Mã:
Sub CellColor()
For Each cel In Union(Range("h5:j8"), Range("C5:E14"))
    cel.Value = cel.Interior.Color
    cel.Font.Color = cel.Value
Next
End Sub
View attachment 254072
Em cảm ơn thầy.
Liệu có thể nâng cấp code tiếp nên nấc nữa được không thầy(không dùng cột F và hàm countif)mà gắn vào nút. Rồi em dí 1 cái nó tòi ra ở cột K không ạ?
 
Lần chỉnh sửa cuối:
Upvote 0
Thì cứ dùng phương pháp "cổ điển gia truyền của GPE": đít sần

For Each rg In Range("M5:Q14").Rows
ki = CStr(rg.Cells(1,1).Interior.Color) & "|" & CStr(rg.Cells(1,2).Interior.Color) & "|" & CStr(rg.Cells(1,3).Interior.Color)
ditSan(ki) = ditSan(ki) + 1
Next rg
Set rg = Range("g5:k5").ReSize(ditSan.Count, )
For i = 1 To ditSan.Count
ki = Split(diSan.Keys()(i-1), "|")
rg.Cells(i, 1).Value = i
rg.Cells(i, 2).Interior.Color = CLng(ki(0))
rg.Cells(i, 3).Interior.Color = CLng(ki(1))
rg.Cells(i, 4).Interior.Color = CLng(ki(2))
rg.Cells(i, 5).Value = ditSan.Items()(i-1)
Next i
 
Upvote 0
Thì cứ dùng phương pháp "cổ điển gia truyền của GPE": đít sần

For Each rg In Range("M5:Q14").Rows
ki = CStr(rg.Cells(1,1).Interior.Color) & "|" & CStr(rg.Cells(1,2).Interior.Color) & "|" & CStr(rg.Cells(1,3).Interior.Color)
ditSan(ki) = ditSan(ki) + 1
Next rg
Set rg = Range("g5:k5").ReSize(ditSan.Count, )
For i = 1 To ditSan.Count
ki = Split(diSan.Keys()(i-1), "|")
rg.Cells(i, 1).Value = i
rg.Cells(i, 2).Interior.Color = CLng(ki(0))
rg.Cells(i, 3).Interior.Color = CLng(ki(1))
rg.Cells(i, 4).Interior.Color = CLng(ki(2))
rg.Cells(i, 5).Value = ditSan.Items()(i-1)
Next i
Untitled.jpg
Vẫn chưa chạy được ạ. Code tinh vi quá, thấy có mấy cái que "l" em không biết cảnh làm cho hết đo đỏ. Full code như nào thầy giúp em tý.
 
Upvote 0
Lần chỉnh sửa cuối:
Upvote 0
Thử UDF này:

PHP:
Public Function CountColors(ByVal rngData As Range, ByVal rngTemp As Range) As Long
Application.Volatile
Dim i As Long, j As Long
Dim col As Long
col = rngData.Columns.Count

For i = 1 To rngData.Rows.Count
    For j = 1 To col
        If rngData.Cells(i, j).Interior.Color <> rngTemp.Cells(1, j).Interior.Color Then Exit For
    Next j
    If j > col Then CountColors = CountColors + 1
Next i

End Function
Trong ô K5 nhập:

=CountColors($C$5:$E$14,H5:J5)
 
Upvote 0
Thử UDF này:

PHP:
Public Function CountColors(ByVal rngData As Range, ByVal rngTemp As Range) As Long
Application.Volatile
Dim i As Long, j As Long
Dim col As Long
col = rngData.Columns.Count

For i = 1 To rngData.Rows.Count
    For j = 1 To col
        If rngData.Cells(i, j).Interior.Color <> rngTemp.Cells(1, j).Interior.Color Then Exit For
    Next j
    If j > col Then CountColors = CountColors + 1
Next i

End Function
Trong ô K5 nhập:

=CountColors($C$5:$E$14,H5:J5)
Vâng.Quá tuyệt vời, Phần mềm này Mỹ tạo ra cho người Việt dùng.Code chay thích lắm ạ.Cảm ơn thầy đã giúp em ạ.
Thầy có ghé lại thêm cho em cái Sub, em sơ đẳng thêm chút thì học được thêm ạ
 
Lần chỉnh sửa cuối:
Upvote 0
Rồi em dí 1 cái nó tòi ra ở cột K không ạ?
Dí cái gì vào cái gì và tòi ra cái gì? Toàn dùng từ gợi cảm ... xúc. Tôi có code (cũng đít sần) nhưng không dí cũng không tòi
PHP:
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
Nhớ xoá trắng bên dưới dữ liệu cột B
 
Lần chỉnh sửa cuối:
Upvote 0
Dí cái gì vào cái gì và tòi ra cái gì? Toàn dùng từ gợi cảm ... xúc. Tôi có code (cũng đít sần) nhưng không dí cũng không tòi
PHP:
Sub CountColor()
Dim DictColor, 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
Nhớ xoá trắng bên dưới dữ liệu cột B
Mừng quá. Nhân đây em chúc thầy và các thầy hay giúp đỡ các em be bé như chúng em năm mới nhiều sức khỏe và thành đạt, thông công.
Ơ trên có từ "...xúc"
 
Lần chỉnh sửa cuối:
Upvote 0
Một câu hỏi Hóc và Búa. :D
Cái búa này hình dạng ra sao? Và cái gì hóc nó?

(*) búa có nhiều dạng tuỳ theo ngành nghề dùng: thợ rèn dùng búa tạ, thợ nguội dùng búa dập, thợ gò đồng dùng búa gõ, thợ mộc dùng búa đinh, thợ lát gạch dùng búa cao su.
Loại ngành nghề đóng cọc dùng loại búa áp lực, cứ nhịp nhàng mà dộng thẳng :p
 
Upvote 0
Những người giỏi VBA,Excel đều là những trai tài gái sắc cả. Những người thành công thì giỏi nhiều thứ có thể có cả VBA,Excel...Nhưng giỏi VBA,Excel chắc chắn thành công ở linh vực của mình (hay gặp dân kỹ thuật, đầu có sạn ở đấy đấy)
 
Upvote 0
Dí cái gì vào cái gì và tòi ra cái gì? Toàn dùng từ gợi cảm ... xúc. Tôi có code (cũng đít sần) nhưng không dí cũng không tòi
PHP:
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
Nhớ xoá trắng bên dưới dữ liệu cột B
Chú Mỹ ơi!
Em chào các thầy và các anh chị ạ!
Sub CountColor chú và các thầy commet giống bài như trong ảnh giúp cháu(em) với ạ!
baigiaicau1.jpg
 
Upvote 0
Upvote 0
Căng quá chú Mỹ ạ! Môn VBA chỗ Thớt này nhiều "chữ" quá chú ạ!
Nhân đây nhờ chứ và các thầy chỉ cho cháu(em) bài tập như sau:
kieu.jpg
 

File đính kèm

  • KIEUTOHOP.xlsm
    23.4 KB · Đọc: 6
Lần chỉnh sửa cuối:
Upvote 0
Nhân đây nhờ chứ và các thầy chỉ cho cháu(em) bài tập như sau:
Này thì chỉ:
- Không dùng Dict
- Dùng 1 vòng lặp duyệt qua các dòng của Range Data: nếu color1 = color2 thì tăng biến MN lên, nếu color2 = color3 thì tăng biến NQ lên
- gán 2 biến xuống 2 ô kết quả
 
Upvote 0
Web KT
Back
Top Bottom