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

Cô Bé Dễ Thương · 8/2/21

Bài này em làm mãi không được ạ. Các thầy và anh chị giúp em với.

ptm0412 · 8/2/21

emgaimuarao đã viết:
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

Cô Bé Dễ Thương · 8/2/21

ptm0412 đã viết:
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 ạ?

VetMini · 8/2/21

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

Cô Bé Dễ Thương · 8/2/21

VetMini đã viết:
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

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ý.

Phuocam · 8/2/21

emgaimuarao đã viết:
Rồi em dí 1 cái nó tòi ra ở cột K không ạ?

Ghi chú: Màu nền dùng RBG(x,y,z) (không dùng mã colorIndex) và dùng VBA để thực hiện công việc

Dùng VBA để viết Sub hay Function?

Cô Bé Dễ Thương · 8/2/21

phuocam đã viết:
Dùng VBA để viết Sub hay Function?

Cái nào cũng dc ạ!

Phuocam · 8/2/21

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)

Cô Bé Dễ Thương · 8/2/21

phuocam đã viết:

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 ạ

ptm0412 · 8/2/21

emgaimuarao đã viết:
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

Cô Bé Dễ Thương · 8/2/21

ptm0412 đã viết:

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"

ptm0412 · 8/2/21

emgaimuarao đã viết:
năm mới nhiều sức khỏe và thành đạt, thông công.

Lại gợi cảm ... xúc, sao lại thông cống?

Cô Bé Dễ Thương · 8/2/21

ptm0412 đã viết:
Lại gợi cảm ... xúc, sao lại thông cống?

Em không thấy có mục donate nhỉ. Một diễn đàn tuyệt vời.

batman1 · 8/2/21

ptm0412 đã viết:
Lại gợi cảm ... xúc, sao lại thông cống?

Một câu hỏi Hóc và Búa.

VetMini · 8/2/21

batman1 đã viết:
Một câu hỏi Hóc và Búa.

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

Cô Bé Dễ Thương · 8/2/21

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)

Cô Bé Dễ Thương · 9/2/21

ptm0412 đã viết:

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 ạ!

ptm0412 · 9/2/21

emgaimuarao đã viết:
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 ạ!

Tập đọc code cho quen đi chứ. Các câu lệnh tương tự sẽ có ý nghĩa tương tự

Cô Bé Dễ Thương · 9/2/21

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:

ptm0412 · 9/2/21

emgaimuarao đã viết:
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ả

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

Thành viên thường trực

File đính kèm

Bad Excel Member

Thành viên thường trực

Ăn cùng góc phố

Thành viên thường trực

Thành viên mới

Thành viên thường trực

Thành viên mới

Thành viên thường trực

Bad Excel Member

Thành viên thường trực

Bad Excel Member

Thành viên thường trực

Thành viên gạo cội

Ăn cùng góc phố

Thành viên thường trực

Thành viên thường trực

Bad Excel Member

Thành viên thường trực

File đính kèm

Bad Excel Member