Tìm kiểu màu trong danh sách. (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
Cô Bé Dễ Thương

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

Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
emgaimuarao đã viết:
Bác lài bồi cho một chùy như vậy nữa. Ác
Nhấp chuột vào đây để mở rộng...
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
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
Nhấp chuột vào đây để mở rộng...
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
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
Nhấp chuột vào đây để mở rộng...
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
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)
Nhấp chuột vào đây để mở rộng...
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
emgaimuarao đã viết:
Rồi em dí 1 cái nó tòi ra ở cột K không ạ?
Nhấp chuột vào đây để mở rộ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
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
Nhấp chuột vào đây để mở rộng...
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
batman1 đã viết:
Một câu hỏi Hóc và Búa. :D
Nhấp chuột vào đây để mở rộng...
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
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
Nhấp chuột vào đây để mở rộng...
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

Lần chỉnh sửa cuối:
Upvote 0
emgaimuarao đã viết:
Nhân đây nhờ chứ và các thầy chỉ cho cháu(em) bài tập như sau:
Nhấp chuột vào đây để mở rộng...
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
ptm0412 đã viết:
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ả
Nhấp chuột vào đây để mở rộng...
Sub thay "chỉ" bằng "viết". Buồn quá chú Mỹ ạ, cháu ngẫm nghĩ mãi không được. Bí bách kiểu như là trên bảo dưới không nghe ấy ạ. Vì ít vốn vba quá, hay dùng chính là excel, cháu mới tự học được dăm bữa vba. Chú làm ơn " run sub viết" cho cháu với.
 
Upvote 0
emgaimuarao đã viết:
Sub thay "chỉ" bằng "viết". Buồn quá chú Mỹ ạ, cháu ngẫm nghĩ mãi không được. Bí bách kiểu như là trên bảo dưới không nghe ấy ạ.
Nhấp chuột vào đây để mở rộng...
Lại dùng từ ngữ gợi cảm ...xúc. Nhỏ này sao sao á.
PHP: 
Sub SumSameColor()
Dim DataRng As Range
Dim LastRw As Long, MN As Long, NQ As Long
With Sheet1
    LastRw = .Cells(1000, 3).End(xlUp).Row
    Set DataRng = .Range("D23:G" & LastRw)
    For i = 1 To DataRng.Rows.Count
        If DataRng.Cells(i, 1).Interior.Color = _
            DataRng.Cells(i, 2).Interior.Color Then _
            MN = MN + DataRng.Cells(i, 4)
        If DataRng.Cells(i, 2).Interior.Color = _
            DataRng.Cells(i, 3).Interior.Color Then _
            NQ = NQ + DataRng.Cells(i, 4)
    Next
    .[I23].Value = MN
    .[J23].Value = NQ
End With
End Sub
 
Upvote 0
ptm0412 đã viết:
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ả
Nhấp chuột vào đây để mở rộng...
Anh đọc hướng dẫn ở bài #4 rồi xem người ta thực hiện ở bài #5 như thế nào. Nhìn kỹ hình *** thì tôi biết là trình độ của người ta có thể ở mức mà gợi ý của anh không đủ đâu. Tôi mà gặp những người như thế thì bỏ qua hoặc cầy hộ từ A đến Z. Không gợi ý nào đủ khi mà người ta còn không biết tự thêm Sub ... End Sub. Chưa kể là có thể phải thêm chút mắm muối (vd. tạo đít sần). :D

***: nhìn một khúc code chỏng chơ mà tôi thấy buồn cười quá.
 
Upvote 0
batman1 đã viết:
Anh đọc hướng dẫn ở bài #4 rồi xem người ta thực hiện ở bài #5 như thế nào.
***: nhìn một khúc code chỏng chơ mà tôi thấy buồn cười quá.
Nhấp chuột vào đây để mở rộng...
Tôi có xem hình bài 5, vì bài 4 của lão kia nên tôi đợi lão ấy vào mắng, nhưng lão ấy không thích "em gái mưa ... rào" hay sao ấy. Tuy nhiên khi tải file bài 19 tôi thấy đã bớt chỏng chơ, chỉ thiếu khai báo biến. Không chạy được là do lão kia viết chay nên lỗi.
 
Upvote 0
batman1 đã viết:
Anh đọc hướng dẫn ở bài #4 rồi xem người ta thực hiện ở bài #5 như thế nào. Nhìn kỹ hình *** thì tôi biết là trình độ của người ta có thể ở mức mà gợi ý của anh không đủ đâu. Tôi mà gặp những người như thế thì bỏ qua hoặc cầy hộ từ A đến Z. Không gợi ý nào đủ khi mà người ta còn không biết tự thêm Sub ... End Sub. Chưa kể là có thể phải thêm chút mắm muối (vd. tạo đít sần). :D

***: nhìn một khúc code chỏng chơ mà tôi thấy buồn cười quá.
Nhấp chuột vào đây để mở rộng...
Thêm sub và end sub vẫn đỏ. Lúc đó em nghĩ thầy VPE chỉ gợi ý nên cố tình viết thiếu. Mà bài 1 bài 2 với vốn ít ỏi bọn em hay gặp kiểu lỗi biên dịch dạng thừa thiếu dấu cách, dấu phảy, cách thể hiện 1 câu lệnh... mỗi cái nho nhỏ khiến tự biên tự diễn rất khó. Nên em hay xin bài mẫu để tự học từng câu.
Em nghĩ em ham học, xin bài mẫu có làm mệt các thầy 1 chút và cùng các bạn khác nữa cũng được biết thêm cái mới.
Chỉ vì chút đỏ cắt bài mẫu của em thì em buồn quá thầy ơi.
Bài đã được tự động gộp:

ptm0412 đã viết:
Tôi có xem hình bài 5, vì bài 4 của lão kia nên tôi đợi lão ấy vào mắng, nhưng lão ấy không thích "em gái mưa ... rào" hay sao ấy. Tuy nhiên khi tải file bài 19 tôi thấy đã bớt chỏng chơ, chỉ thiếu khai báo biến. Không chạy được là do lão kia viết chay nên lỗi.
Nhấp chuột vào đây để mở rộng...
Cháu cảm ơn chú ạ.
 
Lần chỉnh sửa cuối:
Upvote 0
emgaimuarao đã viết:
Thêm sub và end sub vẫn đỏ.
Nhấp chuột vào đây để mở rộng...
Chuyện đỏ đỏ là chuyện sai, nhầm lẫn, tôi không bàn. Lý do? Vì lỗi và nhầm lẫn thì ai cũng có thể mắc phải, kể cả "cao thủ", chỉ cần một phút không tập trung. Còn chuyện không có Sub ... End Sub mới đáng nói, vì lần đầu tôi mới nhìn thấy. Nó không phải là một dấu phẩy, dấu cách để mà nhấn nhầm trong vô thức. Bỏ Sub và End Sub là phải chủ ý, hoặc không biết là nó phải có. Không thể bỏ Sub ... End Sub do sơ ý được. :D
 
Upvote 0
emgaimuarao đã viết:
Chỉ vì chút đỏ cắt bài mẫu của em thì em buồn quá thầy ơi.
Nhấp chuột vào đây để mở rộng...
Có ai cắt đâu à? Code đầy đủ sửa từ gợi ý bài 4, so sánh để biết đã sửa gì, ở đâu.
PHP: 
Sub testdemsomau()
Dim ditSan, ki
Set ditSan = CreateObject("Scripting.Dictionary")
For Each rg In Range("B5:E14").Rows
    ki = CStr(rg.Cells(1, 2).Interior.Color) & "|" & CStr(rg.Cells(1, 3).Interior.Color) & "|" & CStr(rg.Cells(1, 4).Interior.Color)
    ditSan(ki) = ditSan(ki) + 1
Next rg
Set rg = Range("G5:K5").Resize(ditSan.Count, 5)
For i = 1 To ditSan.Count
    ki = Split(ditSan.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
End Sub
 
Upvote 0
batman1 đã viết:
Chuyện đỏ đỏ là chuyện sai, nhầm lẫn, tôi không bàn. Lý do? Vì lỗi và nhầm lẫn thì ai cũng có thể mắc phải, kể cả "cao thủ", chỉ cần một phút không tập trung. Còn chuyện không có Sub ... End Sub mới đáng nói, vì lần đầu tôi mới nhìn thấy. Nó không phải là một dấu phẩy, dấu cách để mà nhấn nhầm trong vô thức. Bỏ Sub và End Sub là phải chủ ý, hoặc không biết là nó phải có. Không thể bỏ Sub ... End Sub do sơ ý được. :D
Nhấp chuột vào đây để mở rộng...
Vâng. Đầu tiên cũng phải làm cho hết báo lỡi mới kích run, em chủ ý không động 1 tý gì. Để xin full code. Vì em trọng chữ, trọng thầy, không đủ trình thêm những chỗ còn thiếu.
Đang cần thầy bạn chỉ cho mà bị ghét thì hết đường để học.
Có gì bỏ qua cho em nhé
 
Lần chỉnh sửa cuối:
Upvote 0
ptm0412 đã viết:
Lại dùng từ ngữ gợi cảm ...xúc. Nhỏ này sao sao á.
PHP: 
Sub SumSameColor()
Dim DataRng As Range
Dim LastRw As Long, MN As Long, NQ As Long
With Sheet1
    LastRw = .Cells(1000, 3).End(xlUp).Row
    Set DataRng = .Range("D23:G" & LastRw)
    For i = 1 To DataRng.Rows.Count
        If DataRng.Cells(i, 1).Interior.Color = _
            DataRng.Cells(i, 2).Interior.Color Then _
            MN = MN + DataRng.Cells(i, 4)
        If DataRng.Cells(i, 2).Interior.Color = _
            DataRng.Cells(i, 3).Interior.Color Then _
            NQ = NQ + DataRng.Cells(i, 4)
    Next
    .[I23].Value = MN
    .[J23].Value = NQ
End With
End Sub
Nhấp chuột vào đây để mở rộng...
Code này thích thế. Dễ chế cháo cho nhiều bài tập.
 
Upvote 0
ptm0412 đã viết:
... vì bài 4 của lão kia nên tôi đợi lão ấy vào mắng, ...
Nhấp chuột vào đây để mở rộng...
Tôi vốn làm việc với con số, và giải trí bằng văn (hoặc đôi khi, nghệ thuật). Ít khi tôi trộn lẫn hai thứ.
Tô màu mè trong Excel là chuyện cực chẳng đã cho nên tôi không muốn nhúng vào sâu hơn. Tôi có mấy người bạn bệnh mù màu cho nên tôi biết tô màu không có ý thức là làm khó cho những người này. Đối với họ, chỉ có trắng đen và xám, các màu có độ xám gần nhau sẽ không phân biệt được.
 
Upvote 0
ptm0412 đã viết:
Code nào cũng hay, cũng chế cháo được. Biết đọc code là được rồi, sau đó sẽ tự viết
Nhấp chuột vào đây để mở rộng...
Vâng. Với bài #30 này cháu làm theo chế được nhiều bài tập. Có bài cháu chế đến 20 biến mà vẫn gọn gàng. Chế được chạy đúng, mà vẫn mơ màng chỗ vòng For sao không "Next i" mà lại Next range = MN(NQ).
 
Upvote 0
Upvote 0
ptm0412 đã viết:
Vậy cho tôi xem code cháo cho biến thứ 3 là MQ.

Đừng mơ, thắc mắc thì hỏi và hỏi cho rõ ràng
Nhấp chuột vào đây để mở rộng...
bienmq.jpg
Mã: 
Sub SumSameColor()
Dim DataRng As Range
Dim LastRw As Long, MN As Long, NQ As Long, MQ As Long
With Sheet1
    LastRw = .Cells(1000, 3).End(xlUp).Row
    Set DataRng = .Range("D23:G" & LastRw)
    For i = 1 To DataRng.Rows.Count
        If DataRng.Cells(i, 1).Interior.Color = _
            DataRng.Cells(i, 2).Interior.Color Then _
            MN = MN + DataRng.Cells(i, 4)
        If DataRng.Cells(i, 2).Interior.Color = _
            DataRng.Cells(i, 3).Interior.Color Then _
            NQ = NQ + DataRng.Cells(i, 4)
        If DataRng.Cells(i, 1).Interior.Color = _
            DataRng.Cells(i, 3).Interior.Color Then _
            MQ = MQ + DataRng.Cells(i, 4)
    Next
    .[I23].Value = MN
    .[J23].Value = NQ
    .[K23].Value = MQ
End With
End Sub
 
Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
emgaimuarao đã viết:
Mã: 
    .[K23].Value = MQ
Nhấp chuột vào đây để mở rộng...
Cháo ngon đấy bé. Còn Next không có i là viết tắt, VBA hiểu là Next của For đầu tiên nhìn thấy từ dưới lên. Nếu nhiều vòng for lồng nhau thì không nên viết tắt, nhưng nếu tắt thì VBA vẫn hiểu Next theo thứ tự từ trong ra ngoài
 
Upvote 0
ptm0412 đã viết:
Cháo ngon đấy bé. Còn Next không có i là viết tắt, VBA hiểu là Next của For đầu tiên nhìn thấy từ dưới lên. Nếu nhiều vòng for lồng nhau thì không nên viết tắt, nhưng nếu tắt thì VBA vẫn hiểu Next theo thứ tự từ trong ra ngoài
Nhấp chuột vào đây để mở rộng...
Vâng.Giống như dùng "If - End If" thì có thể viết tắt để bỏ "End if" như trong bài #30.
 
Upvote 0
Upvote 0
ptm0412 đã viết:
Thử code với điều kiện khác: cộng các trường hợp M và N đảo ngược nhau, N và Q đảo ngược nhau, M và Q đảo ngược nhau.
Nhấp chuột vào đây để mở rộng...
Code hay ở bảng bao nhiêu cột, dòng cũng dc, muốn trích cái gì ra cũng đc. Cháu chẻ nhỏ MN, NQ, MQ:
MN = MN1 + MN2 + ...+ MNn (n thuộc Z)
...
MQ = MQ1 + MQ2 +...+ MQn
Với mỗi số hạng của tổng trên là 1 biến. Mỗi biến đó được gắn với giá trị của cell. Thì vẫn gọn gàng tường minh.
Phải nói là trích lọc rất "cưng". Với rất nhiều điều kiện.
 
Upvote 0
emgaimuarao đã viết:
Phải nói là trích lọc rất "cưng". Với rất nhiều điều kiện.
Nhấp chuột vào đây để mở rộng...
Nói hay lắm, nhưng nếu dữ liệu nhiều chừng chục ngàn dòng thì phải nghiên cứu thêm về mảng và các công cụ khác. Và hãy nhớ lại bài của bác @VetMini nói về việc tô màu: Tô màu không phải là giải pháp cho việc thay thế mã (như mấy bài trên đây):
- Thứ nhất là rườm rà bảng tính, in ra cũng chẳng hiểu được mà còn tốn mực
- Thứ hai là bắt buộc phải đọc từng cell chứ không đưa vào mảng để lợi dụng bộ nhớ nhằm tăng tốc độ
- Thứ ba là không thể ứng dụng các công cụ mạnh như ADO, Power query, ...
 
Upvote 0
ptm0412 đã viết:
Nói hay lắm, nhưng nếu dữ liệu nhiều chừng chục ngàn dòng thì phải nghiên cứu thêm về mảng và các công cụ khác. Và hãy nhớ lại bài của bác @VetMini nói về việc tô màu: Tô màu không phải là giải pháp cho việc thay thế mã (như mấy bài trên đây):
- Thứ nhất là rườm rà bảng tính, in ra cũng chẳng hiểu được mà còn tốn mực
- Thứ hai là bắt buộc phải đọc từng cell chứ không đưa vào mảng để lợi dụng bộ nhớ nhằm tăng tốc độ
- Thứ ba là không thể ứng dụng các công cụ mạnh như ADO, Power query, ...
Nhấp chuột vào đây để mở rộng...
Vâng a.
Chúc chú và toàn thể gia đình, chúc các thầy và toàn thể anh chị em diễn đàn. Sang năm mới dồi dào sức khỏe, nhiều niềm vui và may mắn.
 
Upvote 0
ptm0412 đã viết:
Có ai cắt đâu à? Code đầy đủ sửa từ gợi ý bài 4, so sánh để biết đã sửa gì, ở đâu.
PHP: 
Sub testdemsomau()
Dim ditSan, ki
Set ditSan = CreateObject("Scripting.Dictionary")
For Each rg In Range("B5:E14").Rows
    ki = CStr(rg.Cells(1, 2).Interior.Color) & "|" & CStr(rg.Cells(1, 3).Interior.Color) & "|" & CStr(rg.Cells(1, 4).Interior.Color)
    ditSan(ki) = ditSan(ki) + 1
Next rg
Set rg = Range("G5:K5").Resize(ditSan.Count, 5)
For i = 1 To ditSan.Count
    ki = Split(ditSan.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
End Sub
Nhấp chuột vào đây để mở rộng...
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)
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
emgaimuarao đã viết:
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)
Nhấp chuột vào đây để mở rộng...
Bạn thử sửa dòng:
Mã: 
Set SampleRng = .Range("H5:J8")
Thành:
Mã: 
Set SampleRng = .Range("H5:J11")
 
Upvote 0
Hoàng Nhật Phương đã viết:
Bạn thử sửa dòng:
Mã: 
Set SampleRng = .Range("H5:J8")
Thành:
Mã: 
Set SampleRng = .Range("H5:J11")
Nhấp chuột vào đây để mở rộng...
Em cảm ơn anh.Em hiểu ý anh. Bài này dữ liệu ở bảng "NỘI LỰC DẦM MẪU" là cố đinh. Nó chỉ có 4 kiểu. dữ liệu chỉ ở bảng "NỘI LỰC DẦM HIỆN TẠI" mới thay đổi và thêm bớt (có kiểu trùng bảng "NỘI LỰC DẦM MẪU" hoặc không trùng). Ở bài 1 này em chỉ trích ra những kiểu trùng nhau giữa 2 bảng, và đếm xem các kiểu trùng lặp đó là bao nhiêu lần,
Nếu vẫn dùng phương án Dictionary vẫn phải có đoạn code xóa kye không trùng khi tạo kye từ bảng "NỘI LỰC DẦM HIỆN TẠI", mà cái này em thì ...chưa đủ kiến thức ạ!
 
Upvote 0
emgaimuarao đã viết:
- Đầ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".
Nhấp chuột vào đây để mở rộng...
key chứ kye là kí rì. Đã là mẫu thì khi tạo dữ liệu phải tạo theo mẫu đã có. Mẫu chưa có phải tạo xong rồi mới tạo dữ liệu chứ.
Ngoài ra code của bác @VetMini cũng đã tạo ra thêm mẫu (key) khi dữ liệu tăng thêm mà chưa có mẫu đấy thôi. Vấn đề là thêm 1 biến lấy dòng cuối dữ liệu để chạy hết dữ liệu thay vì chỉ đến 19
 
Lần chỉnh sửa cuối:
Upvote 0
ptm0412 đã viết:
key chứ kye là kí rì. Đã là mẫu thì khi tạo dữ liệu phải tạo theo mẫu đã có. Mẫu chưa có phải tạo xong rồi mới tạo dữ liệu chứ.
Ngoài ra code của bác @VetMini cũng đã tạo ra thêm mẫu (key) khi dữ liệu tăng thêm mà chưa có mẫu đấy thôi. Vấn đề là thêm 1 biến lấy dòng cuối dữ liệu để chạy hết dữ liệu thay vì chỉ đến 19
Nhấp chuột vào đây để mở rộng...
Vâng.
Bài 1 này Bảng Mẫu thì có giới hạn,còn Bảng Hiện Tại thì có nhiều số kiểu và số dòng lớn hơn mẫu. Có 2 trường hớp:
- TH1: số kiểu 2 bảng bằng nhau thì 2 code xử lý được
- TH2: số kiểu bảng bảng Hiện Tại nhiều hơn bảng Mẫu thì chưa xử lý được.
Ở TH2 nếu giải theo Dictionary thì có cách nào loại bỏ được các key không trung nhau giữa 2 bảng không hả chú?
 
Upvote 0
emgaimuarao đã viết:
Ở TH2 nếu giải theo Dictionary thì có cách nào loại bỏ được các key không trung nhau giữa 2 bảng không hả chú?
Nhấp chuột vào đây để mở rộng...
Loại là loại làm sao? Code CountColor chỉ đếm mẫu có sẵn, mẫu không có sẵn (không trùng nhau) thì không đếm đó. Tuy nhiên cũng phải thêm biến tìm dòng cuối và 1 If

Hoàng Nhật Phương đã viết:
Bạn thử sửa dòng:
Mã: 
Set SampleRng = .Range("H5:J8")
Thành:
Mã: 
Set SampleRng = .Range("H5:J11")
Nhấp chuột vào đây để mở rộng...
Bên kia chưa xong mà lon ton qua đây bon chen
 
Lần chỉnh sửa cuối:
Upvote 0
ptm0412 đã viết:
Bên kia chưa xong mà lon ton qua đây bon chen
Nhấp chuột vào đây để mở rộng...
Con thấy Chú Mỹ vất vả quá định tiếp sức cho Chú nhưng con đã chỉ rồi, với yêu cầu mới này mà bảng mẫu chỉ lấy 4 dòng mẫu 'H5:J8' mà trong khi bảng hiện tại lại bổ sung thêm.. mà bảng mẫu không bổ sung thêm thì nó lấy cái gì để gán vào Dic để tra chứ..con thua rồi Chú Mỹ tiếp tục nhé, con không bon chen nữa ạ
 
Upvote 0
ptm0412 đã viết:
Loại là loại làm sao? Code CountColor chỉ đếm mẫu có sẵn, mẫu không có sẵn (không trùng nhau) thì không đếm đó. Tuy nhiên cũng phải thêm biến tìm dòng cuối


Bên kia chưa xong mà lon ton qua đây bon chen
Nhấp chuột vào đây để mở rộng...
Hoàng Nhật Phương đã viết:
Con thấy Chú Mỹ vất vả quá định tiếp sức cho Chú nhưng con đã chỉ rồi, với yêu cầu mới này mà bảng mẫu chỉ lấy 4 dòng mẫu 'H5:J8' mà trong khi bảng hiện tại lại bổ sung thêm.. mà bảng mẫu không bổ sung thêm thì nó lấy cái gì để gán vào Dic để tra chứ..con thua rồi Chú Mỹ tiếp tục nhé, con không bon chen nữa ạ
Nhấp chuột vào đây để mở rộng...
- TH1: Đúng như chị hiểu đấy ạ.Bảng mẫu chỉ lấy đến H5:J8. Key ở Bảng Mẫu và bảng Hiện Tại giống nhau => 2 code trên áp dụng bài 1 được giải quyết xong
- TH2: Nhưng ở trường hợp Key ở bảng Hiện Tại nhiều hơn Key bảng Mẫu, mà vẫn giải theo Dictionary thì hay chăng phải có đoạn code loại bỏ được những kye không trùng nhau đó thì 2 code trên mới thực hiện được.
Khi giải bài 1 theo Dictionary ở TH2. Vậy làm cách nào để loại bỏ được những kye không trùng nhau giữa 2 danh sách? Mong chú @ptm0412 @VetMini...và các anh chị...
giúp cháu với ạ.
Hay là không thể áp dụng Dictionary trong TH2 này được ạ?
 
Upvote 0
emgaimuarao đã viết:
- TH1: Đúng như chị hiểu đấy ạ.Bảng mẫu chỉ lấy đến H5:J8. Key ở Bảng Mẫu và bảng Hiện Tại giống nhau => 2 code trên áp dụng bài 1 được giải quyết xong
- TH2: Nhưng ở trường hợp Key ở bảng Hiện Tại nhiều hơn Key bảng Mẫu, mà vẫn giải theo Dictionary thì hay chăng phải có đoạn code loại bỏ được những kye không trùng nhau đó thì 2 code trên mới thực hiện được.
Khi giải bài 1 theo Dictionary ở TH2. Vậy làm cách nào để loại bỏ được những kye không trùng nhau giữa 2 danh sách? Mong chú @ptm0412 @VetMini...và các anh chị...
giúp cháu với ạ.
Hay là không thể áp dụng Dictionary trong TH2 này được ạ?
Nhấp chuột vào đây để mở rộng...
Gợi ý rồi mà.
Code này chỉ đếm mẫu có sẵn (4 mẫu), bỏ qua những dữ liệu không có trong mẫu sẽ không đếm. Đáng lẽ chỉ được nhập liệu với mẫu có sẵn, mẫu nào chưa có phải khai báo (giống như bảng mã chuẩn)
Ngoài ra mở rộng DataRng đến dòng cuối thay vì chỉ đến 19.
PHP: 
Sub CountColor()
Dim Dict, SampleRng As Range, DataRng As Range
Dim TotalColor As Long, RArr(), Tmp As Long, LastRw As Long
With Sheet1
    Set SampleRng = .Range("H5:J8")
    LastRw = .Cells(10000, 2).End(xlUp).Row
    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)
        If Tmp <> 0 Then RArr(Tmp, 1) = RArr(Tmp, 1) + 1
    Next
    .Range("K5").Resize(Dict.Count, 1) = RArr
End With
End Sub
 
Upvote 0
ptm0412 đã viết:
Gợi ý rồi mà.
Code này chỉ đếm mẫu có sẵn (4 mẫu), bỏ qua những dữ liệu không có trong mẫu sẽ không đếm. Đáng lẽ chỉ được nhập liệu với mẫu có sẵn, mẫu nào chưa có phải khai báo (giống như bảng mã chuẩn)
Ngoài ra mở rộng DataRng đến dòng cuối thay vì chỉ đến 19.
PHP: 
Sub CountColor()
Dim Dict, SampleRng As Range, DataRng As Range
Dim TotalColor As Long, RArr(), Tmp As Long, LastRw As Long
With Sheet1
    Set SampleRng = .Range("H5:J8")
    LastRw = .Cells(10000, 2).End(xlUp).Row
    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)
        If Tmp <> 0 Then RArr(Tmp, 1) = RArr(Tmp, 1) + 1
    Next
    .Range("K5").Resize(Dict.Count, 1) = RArr
End With
End Sub
Nhấp chuột vào đây để mở rộng...
lan1.jpg
- Công việc cháu đang làm Mẫu là cái cố định, khi chạy nội lực thay đổi tải trọng nó ra rất nhiều kiểu lớn hơn số kiểu của mẫu. Nên mẫu là cố định ạ.
- Mong chú có thể giúp chúng cháu loại bỏ key không trùng giữa 2 bảng bằng code thì cái phần trồi #N/A kia cũng xử lý được luôn phải không ạ.
Bài đã được tự động gộp:

Hoàng Nhật Phương đã viết:
Không dễ ăn như vậy đâu Chú Mỹ ơi, khả năng đập đi xây lại Chú ạ. :yahoo:
Nhấp chuột vào đây để mở rộng...
Nhất chị. Thực ra em vướng từ trong tết. Tưởng được gặp được bài tương tự mà không có. Có lẽ Dictionary nên được các chú cho 1 đoạn code loại bỏ key không trùng giữa 2 danh sách. Lúc đó mới gọi là full bài Dictionary được chị nhỉ?
 
Lần chỉnh sửa cuối:
Upvote 0
ptm0412 đã viết:
Test đi kưng. Chú tét rồi

View attachment 254202
Nhấp chuột vào đây để mở rộng...

Hehe, có thể Chú Mỹ test chưa kỹ,code chú chỉ loại bỏ nếu các ô màu không được gán vào Dic, nhưng mong muốn của Bạn ấy là dữ liệu đầu vào chỉ có 4 dòng trong bảng mẫu & các dòng trong bảng hiện tại không động chạm gì thêm ở các dòng trong bảng mẫu nữa mà vẫn có thể ra kết quả vào các dòng thêm mới ở bảng mẫu đó a . :wallbash:
Và đã có kết quả test ở bài 54 kìa Chú:
1613491447164.png
 
Upvote 0
Hoàng Nhật Phương đã viết:
Không dễ ăn như vậy đâu Chú Mỹ ơi, khả năng đập đi xây lại Chú ạ. :yahoo:
Nhấp chuột vào đây để mở rộng...
Đập là đập thế nào, lại bon chen. Cách khác không cần xử lý trồi với sụt đây:

PHP: 
    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
        If Dict.Exists(TotalColor) Then
            Tmp = Dict.Item(TotalColor)
            RArr(Tmp, 1) = RArr(Tmp, 1) + 1
        End If
 Next
 
Lần chỉnh sửa cuối:
Upvote 0
ptm0412 đã viết:
Đập là đập thế nào, lại bon chen. Cách khác không cần xử lý trồi với sụt đây:

PHP: 
    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
        If Dict.Exists(TotalColor) Then RArr(Tmp, 1) = RArr(Tmp, 1) + 1
    Next
Nhấp chuột vào đây để mở rộng...
Cháu có thể hiểu đoạn này là loại bỏ kye không trùng phải không chú.
ptm0412 đã viết:
Này thì xử lý trồi

View attachment 254207
Nhấp chuột vào đây để mở rộng...
Tới tấp bài mới sướng quá nhìn lộn không phải chị Phương mà là của chú Mỹ 2 cách.
 
Upvote 0
emgaimuarao đã viết:
Đúng là xử lý được bài #54. Chị giải thích thêm cho em 2 cái này.lõi như nhau sao hết được trồi ở bài#54 vậy chị?
Nhấp chuột vào đây để mở rộng...
Ủa thế OTnhầm, cứ OT cứ tưởn bạn muốn thêm kết quả như trong file mẫu 'Dammau1 1-cothemmoi.xlsm' bạn gửi ở 43, chính vì thế OT mới bảo bạn xử lý như bài 44:

1613492271346.png

Xin lỗi OT hiểu nhầm, haiz, đúng là không nên bon chen.:wallbash:
Bài đã được tự động gộp:

ptm0412 đã viết:
Pậy pạ nà. Bỏ cái trồi trồi đó là xong rồi
Nhấp chuột vào đây để mở rộng...
Xin lỗi Chú Mỹ nhé, vì file đính kèm có kết quả mẫu,con chạy code thấy lỗi nên xử lý code theo kết quả mẫu.
Bài 49 con đã rút nui rồi mà nhưng cái tật bon chen không bao giờ sửa được (@$%@
 
Upvote 0
emgaimuarao đã viết:
Cháu có thể hiểu đoạn này là loại bỏ kye không trùng phải không chú.

Tới tấp bài mới sướng quá nhìn lộn không phải chị Phương mà là của chú Mỹ 2 cách.
Nhấp chuột vào đây để mở rộng...
Đã nói là key, không phải kye. Nó có nghĩa là "Nếu có tồn tại trong Dict" (tức là có giống với 1 mẫu), ngược lại (không giống mẫu nào) thì không làm gì cả (không có else)
Sướng quá giờ làm sao?

Hoàng Nhật Phương đã viết:
Xin lỗi Chú Mỹ nhé, vì file đính kèm có kết quả mẫu,con chạy code thấy lỗi nên xử lý code theo kết quả mẫu.
Bài 49 con đã rút nui rồi mà nhưng cái tật bon chen không bao giờ sửa được
Nhấp chuột vào đây để mở rộng...
Cần gì xử lý, lấy thủ tục testdemsomau() của bác @VetMini thêm biến dòng cuối là ra rồi. Nhưng do bon chen nên không đọc yêu cầu mới chỗ trồi trồi
 
Lần chỉnh sửa cuối:
Upvote 0
ptm0412 đã viết:
Đã nói là key, không phải kye. Nó có nghĩa là "Nếu có tồn tại trong Dict" (tức là có giống với 1 mẫu), ngược lại (không giống mẫu nào) thì không làm gì cả (không có else)
Sướng quá giờ làm sao?


Cần gì xử lý, lấy thủ tục testdemsomau() của bác @VetMini thêm biến dòng cuối là ra rồi. Nhưng do bon chen nên không đọc yêu cầu mới chỗ trồi trồi
Nhấp chuột vào đây để mở rộng...
Thích quá giờ không biết làm sao. Làm thành viên diễn đàn chú đã sướng thế này. Nếu là hàng xóm thì... phải biết đấy.
Chú xử tiếp code của chú @VetMini. Giảng cho chúng cháu bài #55, #57 thì hiện tại đến đây mới là full bài Dictionary chú ạ!
 
Upvote 0
emgaimuarao đã viết:
Thích quá giờ không biết làm sao. Làm thành viên diễn đàn chú đã sướng thế này. Nếu là hàng xóm thì... phải biết đấy.
Chú xử tiếp của code của chú @VetMini. Giảng cho chúng cháu bài #55, #57 thì hiện tại đến đây mới là full bài Dictionary chú ạ!
Nhấp chuột vào đây để mở rộng...
Nếu là hàng xóm thì sang đánh nhau à?
Bài 57 giải thích tại bài 63, còn bài 55:
PHP: 
        Tmp = Dict.Item(TotalColor) 'add 1 key vào Dict với item rỗng'
        If Tmp <> 0 Then RArr(Tmp, 1) = RArr(Tmp, 1) + 1
Nghĩa là khi không có sẵn mẫu trùng, Dict vẫn bị add thêm 1 key là TotalColor với item rỗng (item rỗng lấy ra cho vào biến Tmp sẽ là 0). Chạy hết dữ liệu thì đã bị add vài ba lần như thế. Sau khi bị add thì Dict.Count tăng lên 7 không còn là 4 nữa. Trong khi RArr() giới hạn chỉ 4 dòng, K5 mà resize 7 dòng mà gán RArr 4 dòng thì 3 dòng lỗi NA.
Biện pháp là trước khi gán tào lao vô Dict thì Count Dict trước cho vào biến DictCount, (kết quả 4), K5 resize 4 khớp với RArr, hết lỗi NA
______
Code bác @VetMini thêm biến dòng cuối:
PHP: 
Sub testdemsomau()
Dim ditSan, ki, LastRw As Long
LastRw = [B1000].End(xlUp).Row
Set ditSan = CreateObject("Scripting.Dictionary")
For Each rg In Range("B5:E" & LastRw).Rows
    ki = CStr(rg.Cells(1, 2).Interior.Color) & "|" & CStr(rg.Cells(1, 3).Interior.Color) & "|" & CStr(rg.Cells(1, 4).Interior.Color)
    ditSan(ki) = ditSan(ki) + 1
Next rg
Set rg = Range("G5:K5").Resize(ditSan.Count, 4)
For i = 1 To ditSan.Count
    ki = Split(ditSan.keys()(i - 1), "|")
    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
End Sub
Code đập đi làm lại:
PHP: 
Sub countNotSample()
Dim Dict, DataRng As Range, LastRw As Long
Dim TotalColor As Long, RArr(), Tmp As Long
With Sheet1
    .Range("H5:K100").Clear
    LastRw = .Cells(10000, 2).End(xlUp).Row
    Set DataRng = .Range("C5:E" & LastRw)
    ReDim RArr(1 To DataRng.Rows.Count, 1 To 4)
    Set Dict = CreateObject("Scripting.Dictionary")
    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
        If Not Dict.Exists(TotalColor) Then
            k = k + 1
            Dict.Add TotalColor, k
            RArr(k, 1) = DataRng.Cells(i, 1).Interior.Color
            RArr(k, 2) = DataRng.Cells(i, 2).Interior.Color
            RArr(k, 3) = DataRng.Cells(i, 3).Interior.Color
            RArr(k, 4) = 1
        Else
            Tmp = Dict.Item(TotalColor)
            RArr(Tmp, 4) = RArr(Tmp, 4) + 1
        End If
    Next
    For i = 1 To k
        .Cells(i + 4, 8).Interior.Color = RArr(i, 1)
        .Cells(i + 4, 9).Interior.Color = RArr(i, 2)
        .Cells(i + 4, 10).Interior.Color = RArr(i, 3)
        .Cells(i + 4, 11) = RArr(i, 4)
    Next
End With
      
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
ptm0412 đã viết:
Nếu là hàng xóm thì sang đánh nhau à?
Bài 57 giải thích tại bài 63, còn bài 55:
PHP: 
        Tmp = Dict.Item(TotalColor) 'add 1 key vào Dict với item rỗng'
        If Tmp <> 0 Then RArr(Tmp, 1) = RArr(Tmp, 1) + 1
Nghĩa là khi không có sẵn mẫu trùng, Dict vẫn bị add thêm 1 key là TotalColor với item rỗng (item rỗng lấy ra cho vào biến Tmp sẽ là 0). Chạy hết dữ liệu thì đã bị add vài ba lần như thế. Sau khi bị add thì Dict.Count tăng lên 7 không còn là 4 nữa. Trong khi RArr() giới hạn chỉ 4 dòng, K5 mà resize 7 dòng mà gán RArr 4 dòng thì 3 dòng lỗi NA.
Biện pháp là trước khi gán tào lao vô Dict thì Count Dict trước cho vào biến DictCount, (kết quả 4), K5 resize 4 khớp với RArr, hết lỗi NA
______
Code bác @VetMini thêm biến dòng cuối:
PHP: 
Sub testdemsomau()
Dim ditSan, ki, LastRw As Long
LastRw = [B1000].End(xlUp).Row
Set ditSan = CreateObject("Scripting.Dictionary")
For Each rg In Range("B5:E" & LastRw).Rows
    ki = CStr(rg.Cells(1, 2).Interior.Color) & "|" & CStr(rg.Cells(1, 3).Interior.Color) & "|" & CStr(rg.Cells(1, 4).Interior.Color)
    ditSan(ki) = ditSan(ki) + 1
Next rg
Set rg = Range("G5:K5").Resize(ditSan.Count, 4)
For i = 1 To ditSan.Count
    ki = Split(ditSan.keys()(i - 1), "|")
    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
End Sub
Code đập đi làm lại:
PHP: 
Sub countNotSample()
Dim Dict, DataRng As Range, LastRw As Long
Dim TotalColor As Long, RArr(), Tmp As Long
With Sheet1
    .Range("H5:K100").Clear
    LastRw = .Cells(10000, 2).End(xlUp).Row
    Set DataRng = .Range("C5:E" & LastRw)
    ReDim RArr(1 To DataRng.Rows.Count, 1 To 4)
    Set Dict = CreateObject("Scripting.Dictionary")
    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
        If Not Dict.Exists(TotalColor) Then
            k = k + 1
            Dict.Add TotalColor, k
            RArr(k, 1) = DataRng.Cells(i, 1).Interior.Color
            RArr(k, 2) = DataRng.Cells(i, 2).Interior.Color
            RArr(k, 3) = DataRng.Cells(i, 3).Interior.Color
            RArr(k, 4) = 1
        Else
            Tmp = Dict.Item(TotalColor)
            RArr(Tmp, 1) = RArr(Tmp, 1) + 1
        End If
    Next
    For i = 1 To k
        .Cells(i + 4, 8).Interior.Color = RArr(i, 1)
        .Cells(i + 4, 9).Interior.Color = RArr(i, 2)
        .Cells(i + 4, 10).Interior.Color = RArr(i, 3)
        .Cells(i + 4, 11) = RArr(i, 4)
    Next
End With
       
End Sub
Nhấp chuột vào đây để mở rộng...
Hàng xóm với chú thì qua nhậu với chú với hát karaoke ạ. Chú ngủ sớm đi ạ. Chúc chú ngủ ngon ạ!
 
Lần chỉnh sửa cuối:
Upvote 0
Upvote 0
ptm0412 đã viết:
Nhờ bon chen nên chú tăng được mấy bài mắng, mà hễ mắng thì thêm mưa tim, chú tăng hạng. Cứ thế phát huy nhé :P
Nhấp chuột vào đây để mở rộng...
Lúc đấy cháu cũng sợ quá. Quả này bị ghét rồi. Không được chỉ nữa rồi. Lúc đấy buồn lắm may có chị Phương vào mới cảm thấy bớt bớt bị mắng. Bí quá biết làm mỗi động tác thả tim và hỏi đi hỏi lại.
Sau có bài tới lên bị sướng quá. Chắc do sợ quá hic hic.
 
Upvote 0
ptm0412 đã viết:
...Dim TotalColor As Long, RArr(), Tmp As Long
... TotalColor = DataRng.Cells(i, 1).Interior.Color + _
DataRng.Cells(i, 2).Interior.Color + _
DataRng.Cells(i, 3).Interior.Color
...
Nhấp chuột vào đây để mở rộng...
Theo tôi hiểu thì cộng như vậy sẽ bị trùng.
Cùng số nhưng khác thứ tự:
3+4+5 = 12
4+3+5 = 12
Khác số, cùng tổng:
2+4+6 = 12

Nếu tôi lập keys màu thì tôi cộng chuỗi
Join(Array(3, 4, 5), ".") = "3.4.5"
Nếu thứ tự không phân biệt (đỏ, cam, vàng coi như vàng, cam, đỏ) thì phải sắp xếp.
 
Upvote 0
ptm0412 đã viết:
Gợi ý rồi mà.
Code này chỉ đếm mẫu có sẵn (4 mẫu), bỏ qua những dữ liệu không có trong mẫu sẽ không đếm. Đáng lẽ chỉ được nhập liệu với mẫu có sẵn, mẫu nào chưa có phải khai báo (giống như bảng mã chuẩn)
Ngoài ra mở rộng DataRng đến dòng cuối thay vì chỉ đến 19.
PHP: 
Sub CountColor()
Dim Dict, SampleRng As Range, DataRng As Range
Dim TotalColor As Long, RArr(), Tmp As Long, LastRw As Long
With Sheet1
    Set SampleRng = .Range("H5:J8")
    LastRw = .Cells(10000, 2).End(xlUp).Row
    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)
        If Tmp <> 0 Then RArr(Tmp, 1) = RArr(Tmp, 1) + 1
    Next
    .Range("K5").Resize(Dict.Count, 1) = RArr
End With
End Sub
Nhấp chuột vào đây để mở rộng...
ptm0412 đã viết:
Này thì xử lý trồi

View attachment 254207
Nhấp chuột vào đây để mở rộng...
- Code ở bài #51 và cách sửa ở bài #55. Hiện đã giải quyết được vấn đề thêm mẫu mới bất kỳ ở bảng "NỘI LỰC DẦM HIỆN TẠI" và mẫu ở bảng "NỘI LỰC DẦM MẪU" cố định.
- Còn các code ở bài #65 vẫn bị trồi thêm dữ liệu và chép thêm mẫu mới vào bảng "NỘI LỰC DẦM MẪU" chú Mỹ ạ! Liệu có cách nào dùng cách tạo key của chú @VetMini vào bài #51 và #55 không chú @ptm0412 nhỉ.Nếu điều đó là làm được thì sẽ giải quyết thêm được khả năng không mong muốn ở bài #65.
(Bài 51 và 55 hiện đã giải quyết được yêu cầu bài toán, tuy vậy vẫn có khả năng bài #65 xảy ra.Đến đây vẫn là 99%.Nếu dùng được cách tạo key của chú @VetMini thì trọn vẹn)
 
Upvote 0
emgaimuarao đã viết:
khả năng không mong muốn ở bài #65.
(Bài 51 và 55 hiện đã giải quyết được yêu cầu bài toán, tuy vậy vẫn có khả năng bài #65 xảy ra.Đến đây vẫn là 99%.Nếu dùng được cách tạo key của chú @VetMini thì trọn vẹn)
Nhấp chuột vào đây để mở rộng...
Bài 65 là viết để trả lời câu hỏi (yêu cầu) ở bài 64 chứ đâu phải để giải quyết yêu cầu chính? Yêu cầu chính là đã giải quyết bằng 55 và cách 2 bài 57.
code Dictionary của tôi và bác @VetMini là cùng thuật toán, chỉ khác thủ thuật dùng item mà thôi. Ngoài ra theo góp ý của bác ấy:
VetMini đã viết:
Theo tôi hiểu thì cộng như vậy sẽ bị trùng.
Cùng số nhưng khác thứ tự:
3+4+5 = 12
4+3+5 = 12
Khác số, cùng tổng:
2+4+6 = 12

Nếu tôi lập keys màu thì tôi cộng chuỗi
Join(Array(3, 4, 5), ".") = "3.4.5"
Nếu thứ tự không phân biệt (đỏ, cam, vàng coi như vàng, cam, đỏ) thì phải sắp xếp.
Nhấp chuột vào đây để mở rộng...
Khả năng khác số cùng tổng rất ít khả năng xảy ra khi con người tự chọn màu: Thường con người chủ quan chọn những màu khá khác biệt nhau thành 1 bộ.
Khả năng cùng màu nhưng khác thứ tự có thể xảy ra (cũng do con người: thích và chọn 1 số màu này, ít chọn màu khác)
Vậy thì đổi hết những dấu + thành dấu &:
PHP: 
        TotalColor = SampleRng.Cells(i, 1).Interior.Color + _
            SampleRng.Cells(i, 2).Interior.Color + _
            SampleRng.Cells(i, 3).Interior.Color
        Dict.Add TotalColor, i
            '-->'
        TotalColor = SampleRng.Cells(i, 1).Interior.Color & _
            SampleRng.Cells(i, 2).Interior.Color & _
            SampleRng.Cells(i, 3).Interior.Color
        Dict.Add TotalColor, i
 
Upvote 0
ptm0412 đã viết:
Bài 65 là viết để trả lời câu hỏi (yêu cầu) ở bài 64 chứ đâu phải để giải quyết yêu cầu chính? Yêu cầu chính là đã giải quyết bằng 55 và cách 2 bài 57.
code Dictionary của tôi và bác @VetMini là cùng thuật toán, chỉ khác thủ thuật dùng item mà thôi. Ngoài ra theo góp ý của bác ấy:

Khả năng khác số cùng tổng rất ít khả năng xảy ra khi con người tự chọn màu: Thường con người chủ quan chọn những màu khá khác biệt nhau thành 1 bộ.
Khả năng cùng màu nhưng khác thứ tự có thể xảy ra (cũng do con người: thích và chọn 1 số màu này, ít chọn màu khác)
Vậy thì đổi hết những dấu + thành dấu &:
PHP: 
        TotalColor = SampleRng.Cells(i, 1).Interior.Color + _
            SampleRng.Cells(i, 2).Interior.Color + _
            SampleRng.Cells(i, 3).Interior.Color
        Dict.Add TotalColor, i
            '-->'
        TotalColor = SampleRng.Cells(i, 1).Interior.Color & _
            SampleRng.Cells(i, 2).Interior.Color & _
            SampleRng.Cells(i, 3).Interior.Color
        Dict.Add TotalColor, i
Nhấp chuột vào đây để mở rộng...
Với cách tạo key ở bài #71 và bài #4 là tương đương nhau rồi phải không ạ.
Tuy vậy, khi đổi dấu "+" thành "&" để ghép vào bài #51 và #55 code vẫn chưa chay được chú Mỹ ạ. Mong chú xây lại bài #51,#55 với Kye đã chuyển dấu + thành dấu &.
 
Lần chỉnh sửa cuối:
Upvote 0
emgaimuarao đã viết:
Tuy vậy, khi đổi dấu "+" thành "&" để ghép vào bài #51 và #55 code vẫn chưa chay được chú Mỹ ạ. Mong chú xây lại bài #51,#55 với Kye đã chuyển dấu + thành dấu &.
Nhấp chuột vào đây để mở rộng...
- Có 2 chỗ cần chuyển, chắc mới chuyển 1
- Chưa khai báo lại biến TotalColor thành String
PHP: 
Sub CountColor2()
Dim Dict, SampleRng As Range, DataRng As Range
Dim TotalColor As String, RArr(), Tmp As Long, LastRw As Long
With Sheet1
    Set SampleRng = .Range("H5:J8")
    LastRw = .Cells(10000, 2).End(xlUp).Row
    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
        If Dict.Exists(TotalColor) Then
            Tmp = Dict.Item(TotalColor)
            RArr(Tmp, 1) = RArr(Tmp, 1) + 1
        End If
    Next
    .Range("K5").Resize(Dict.Count, 1) = RArr
End With
End Sub
Tuy nhiên nối chuỗi cũng sẽ bị trùng với những Interior.Color ngắn dài không đều
Có lẽ nối thêm ký tự phân cách như bác @VetMini:
PHP: 
    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
        If Dict.Exists(TotalColor) Then
            Tmp = Dict.Item(TotalColor)
            RArr(Tmp, 1) = RArr(Tmp, 1) + 1
        End If
    Next
    .Range("K5").Resize(Dict.Count, 1) = RArr
 
Lần chỉnh sửa cuối:
Upvote 0
ptm0412 đã viết:
- Có 2 chỗ cần chuyển, chắc mới chuyển 1
- Chưa khai báo lại biến TotalColor thành String
PHP: 
Sub CountColor2()
Dim Dict, SampleRng As Range, DataRng As Range
Dim TotalColor As String, RArr(), Tmp As Long, LastRw As Long
With Sheet1
    Set SampleRng = .Range("H5:J8")
    LastRw = .Cells(10000, 2).End(xlUp).Row
    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
        If Dict.Exists(TotalColor) Then
            Tmp = Dict.Item(TotalColor)
            RArr(Tmp, 1) = RArr(Tmp, 1) + 1
        End If
    Next
    .Range("K5").Resize(Dict.Count, 1) = RArr
End With
End Sub
Tuy nhiên nối chuỗi cũng sẽ bị trùng với những Interior.Color ngắn dài không đều
Có lẽ nối thêm ký tự phân cách như bác @VetMini:
PHP: 
    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
        If Dict.Exists(TotalColor) Then
            Tmp = Dict.Item(TotalColor)
            RArr(Tmp, 1) = RArr(Tmp, 1) + 1
        End If
    Next
    .Range("K5").Resize(Dict.Count, 1) = RArr
Nhấp chuột vào đây để mở rộng...
- Sự kết hợp code của 2 chú @ptm0412 @VetMini đã tạo ra tuyệt tác của của trí tuệ.
- Đến bây giờ :"Kính thưa toàn thể quý zị, kính thưa toàn thể bà con và quan viên hai họ" (các bác học về mảng và Dict thì seach:Kính thưa toàn thể quý zị, kính thưa toàn thể bà con và quan viên hai họ, có các bài từ trước những năm 2012). Đến bài #73 với cháu(em) đã đầy đủ về Dictionary trong VBA,đã trọn vẹn 100%.
Với các code của top này thì thỏa thê chế cháo.
- Dictionary vba mạnh khiếp thật.
Cháu cảm ơn hai chú,chúc hai chú luôn khỏe như "Dictionary", tràn đầy năng lượng và nhiệt huyết.
Em cảm ơn các bác!
 
Upvote 0
emgaimuarao đã viết:
đã đầy đủ về Dictionary trong VBA,đã trọn vẹn 100%.
Nhấp chuột vào đây để mở rộng...
Coi chừng sa vào bước xe đổ của @Hoàng Nhật Phương, căn bản chưa vững mà túm lấy công cụ mạnh. Cụ thể là lỗi chưa biết bug để biết chỗ sai, chỗ sai không biết sửa, gợi ý sửa lại làm không đúng.
Ngoài ra nói về Dictionary, item của nó còn nhiều ứng dụng đáng nói, thí dụ như đối với 1 bài toán nào đó sẽ gán item bằng 1 mảng. Vài bữa lại tuyên bố 100% lần 3, lần 4, lần n thì quan viên 2 họ mắng cho, chứ chẳng phải mình lão chết tiệt mắng.
 
Upvote 0
ptm0412 đã viết:
Coi chừng sa vào bước xe đổ của @Hoàng Nhật Phương, căn bản chưa vững mà túm lấy công cụ mạnh. Cụ thể là lỗi chưa biết bug để biết chỗ sai, chỗ sai không biết sửa, gợi ý sửa lại làm không đúng.
Ngoài ra nói về Dictionary, item của nó còn nhiều ứng dụng đáng nói, thí dụ như đối với 1 bài toán nào đó sẽ gán item bằng 1 mảng. Vài bữa lại tuyên bố 100% lần 3, lần 4, lần n thì quan viên 2 họ mắng cho, chứ chẳng phải mình lão chết tiệt mắng.
Nhấp chuột vào đây để mở rộng...
Lần đầu tiên ạ.
Nhưng cách đẻ ra key khó thiệt chú ạ. Nếu vậy đến đây hi vọng đc 50% về Dictionary. Còn 1/2 như chưa biết lúc nào sẽ gặp. Chú bao nhiều sân có gì chú chỉ cháu ít link về item là mảng chú nhé.
 
Lần chỉnh sửa cuối:
Upvote 0
Dictionary không phải của VBA.
Rõ ràng lúc dựng object CreateObject("Scripting.Dictionary"), nó được ttham chiếu từ thư viện Scripting (Microsoft Scripting Runtime library).
Thư viện này nằm trong file ..\Windows\system32\scrrun.DLL (hoặc đại khái vậy) và hoàn toàn không có liên hệ gì đến VBA, Excel, hay Access cả.
 
Upvote 0
emgaimuarao đã viết:
Lần đầu tiên ạ.
Nhưng cách đẻ ra key khó thiệt chú ạ. Nếu vậy đến đây hi vọng đc 50% về Dictionary. Còn 1/2 như chưa biết lúc nào sẽ gặp. Chú bao nhiều sân có gì chú chỉ cháu ít link về item là mảng chú nhé.
Nhấp chuột vào đây để mở rộng...
File dưới đây cùng 1 bài toán, 2 code dùng Dict khác nhau, 1 code dùng Dict với item là mảng, 1 code dùng Dict và 1 mảng kết quả nhưng item được gán và sử dụng linh hoạt.
Ghi chú: code 1 với item là mảng chậm hơn do gán xuống sheet nhiều lần hơn so với code 2 chỉ gán kết quả 1 lần.
Khuyến mãi ảnh cháu ngoại ngày mồng 1
1613634705160.png
 

File đính kèm

Upvote 0
ptm0412 đã viết:
File dưới đây cùng 1 bài toán, 2 code dùng Dict khác nhau, 1 code dùng Dict với item là mảng, 1 code dùng Dict và 1 mảng kết quả nhưng item được gán và sử dụng linh hoạt.
Ghi chú: code 1 với item là mảng chậm hơn do gán xuống sheet nhiều lần hơn so với code 2 chỉ gán kết quả 1 lần.
Khuyến mãi ảnh cháu ngoại ngày mồng 1
View attachment 254255
Nhấp chuột vào đây để mở rộng...
Bé đáng yêu xinh xắn quá chú ạ!
Chú như ông Bụt trong diễn đàn vậy.
Cháu chúc 2 ông cháu lúc nào cũng hạnh phúc đáng yêu!
 
Upvote 0
Upvote 0
Cháu có bài tập số 5: Điền tên vào ô có điều kiện. Mong các chú các bác và các anh chị giúp cháu với ạ!
dienten.jpg
 

File đính kèm

Upvote 0
emgaimuarao đã viết:
Cháu có bài tập số 5: Điền tên vào ô có điều kiện. Mong các chú các bác và các anh chị giúp cháu với ạ!
Nhấp chuột vào đây để mở rộng...
Phải tự suy nghĩ chứ đâu có khó
PHP: 
Sub CheckNote()
Dim Dict, SData As Range, RArr(), Sample As Range
Dim LastRw As Long, sKey As String, DataRows As Long
Set Dict = CreateObject("Scripting.Dictionary")
Set Sample = Range("I5:K8")
For i = 1 To Sample.Rows.Count
    sKey = Sample(i, 1).Interior.Color & _
    "|" & Sample(i, 2).Interior.Color & _
    "|" & Sample(i, 3).Interior.Color
    Dict.Add sKey, i
Next
LastRw = Cells(1000, 2).End(xlUp).Row
Set SData = Range("C5:E" & LastRw)
DataRows = SData.Rows.Count
ReDim RArr(1 To DataRows, 1 To 1)
For i = 1 To DataRows
    sKey = SData(i, 1).Interior.Color & _
    "|" & SData(i, 2).Interior.Color & _
    "|" & SData(i, 3).Interior.Color
    If Dict.exists(sKey) Then RArr(i, 1) = "Yes"
Next
Range("F5:F1000").ClearContents
Range("F5").Resize(UBound(RArr, 1), 1).Value = RArr

End Sub
 
Upvote 0
ptm0412 đã viết:
Phải tự suy nghĩ chứ đâu có khó
PHP: 
Sub CheckNote()
Dim Dict, SData As Range, RArr(), Sample As Range
Dim LastRw As Long, sKey As String, DataRows As Long
Set Dict = CreateObject("Scripting.Dictionary")
Set Sample = Range("I5:K8")
For i = 1 To Sample.Rows.Count
    sKey = Sample(i, 1).Interior.Color & _
    "|" & Sample(i, 2).Interior.Color & _
    "|" & Sample(i, 3).Interior.Color
    Dict.Add sKey, i
Next
LastRw = Cells(1000, 2).End(xlUp).Row
Set SData = Range("C5:E" & LastRw)
DataRows = SData.Rows.Count
ReDim RArr(1 To DataRows, 1 To 1)
For i = 1 To DataRows
    sKey = SData(i, 1).Interior.Color & _
    "|" & SData(i, 2).Interior.Color & _
    "|" & SData(i, 3).Interior.Color
    If Dict.exists(sKey) Then RArr(i, 1) = "Yes"
Next
Range("F5:F1000").ClearContents
Range("F5").Resize(UBound(RArr, 1), 1).Value = RArr

End Sub
Nhấp chuột vào đây để mở rộng...
Cháu sửa các code cũ trong Thớt, đến chỗ tạo skey từ Sdata, nó báo lỗi và vốn " từ vựng vba" còn ít nên người và máy chưa hiểu được nhau.
Code bài #83 có thêm nhiều "từ vựng vba" mới nếu không phải bậc thầy không tạo ra nổi đoạn code trên.
Không biết nói gì hơn. Chỉ biết cảm ơn chú nhiều lắm ạ.Chùm code này trong Thớt này quý giá quá chú ạ. Dict và Arr liên quan nhuần nhuyễn dễ thẩm thấu.
 
Lần chỉnh sửa cuối:
Upvote 0
emgaimuarao đã viết:
Cháu sửa các code cũ trong Thớt, đến chỗ tạo skey từ Sdata, nó báo lỗi và vốn " từ vựng vba" còn ít nên người và máy chưa hiểu được nhau.
Code bài #83 có thêm nhiều "từ vựng vba" mới nếu không phải bậc thầy không tạo ra nổi đoạn code trên.
Nhấp chuột vào đây để mở rộng...
- Lỗi gì khi tạo skey?
- Từ vựng nào mới?
 
Upvote 0
Bài tập này ở đâu ra vậy?
1. Nếu ở trường nào đó thì nghỉ học đi. Trường này dạy đồ trên trời, không thực dụng chút nào cả.
2. Néu tự ra cho mình làm thì quên đi. Loại bày này học nhiều mà thu thập kiến thức rất hẹp (có thể rất sâu nhưng rất hẹp)

Sâu: đi sâu vào bên trong, đến tận gốc.
Hẹp: kiến thức nhặt trong đường đi rất đăc thù, chả sử dụng được vào các trường hợp khác.

Đối với người mới học code, chiều rộng quna trọng hơn chiều sâu. Vì học sâu úa mà không có chỗ ứng dụng thì một thời gian sẽ hoặc tẩu mã hoặc quên béng hết.
Tôi chỉ nói chiều rộng quan trọng hơn thôi chứ chiều sâu cần phải biết chút đỉnh. Không đủ chiều sâu thì rất dễ bị sai.
 
Upvote 0
VetMini đã viết:
Bài tập này ở đâu ra vậy?
1. Nếu ở trường nào đó thì nghỉ học đi. Trường này dạy đồ trên trời, không thực dụng chút nào cả.
2. Néu tự ra cho mình làm thì quên đi. Loại bày này học nhiều mà thu thập kiến thức rất hẹp (có thể rất sâu nhưng rất hẹp)

Sâu: đi sâu vào bên trong, đến tận gốc.
Hẹp: kiến thức nhặt trong đường đi rất đăc thù, chả sử dụng được vào các trường hợp khác.

Đối với người mới học code, chiều rộng quna trọng hơn chiều sâu. Vì học sâu úa mà không có chỗ ứng dụng thì một thời gian sẽ hoặc tẩu mã hoặc quên béng hết.
Tôi chỉ nói chiều rộng quan trọng hơn thôi chứ chiều sâu cần phải biết chút đỉnh. Không đủ chiều sâu thì rất dễ bị sai.
Nhấp chuột vào đây để mở rộng...
Nó là bài thiết kế cấu kiện bê tông cốt thép bác ạ. Tô màu là dạng giá trị thay đổi (khoảng giá trị mà ta đặt ra). Mỗi 1 trường tải trọng thì nội lực thay đổi. Hiện giá trị là màu sắc xem có thay đổi nhiều không. Để tiết kiệm, để đủ khả năng chịu lực. Cứ làm thì nó nảy ra vấn đề mới. Từ đó nó các dạng bài tập trong thớt. Từ đó trích lọc phân tích đánh giá dữ liệu của mình.
Dù sao may mà có các code của chú Mỹ không thì cháu cũng bế tắc. Mà dùng thuần excel file rất nặng vì thế cháu mới chuyển qua vba.
Bác nặng lời quá. Đúng là cháu mới bắt đầu đc 1 tháng. Nhưng vừa học mà ứng dụng vào việc của mình luôn thì quá may mắn. Theo cháu ứng dụng được rất nhiều. Bổ xung cho thớt về dict rất nhiều, nhiều người học về vba thì cũng gặp vấn đề như cháu thôi.
 
Upvote 0
Ứng dụng như vậy mà dùng màu là tự làm khó mình.
Nếu của mấy thằng kỹ sư công trình chúng bắt làm vậy thì là do tụi nó dốt về quản trị dữ liệu rồi bày đặt màu mè để che lấp cái lười học hỏi thêm của mình. Mà cái này thì trường hợp bạn chắc phải chịu thua. Tuy nhiên bạn phải tìm cách nói khéo với chúng là đòi hỏi này rất khó, và bạn phải nhờ nhiều chỗ mới thực hiện được. Nếu bạn ngại không nói là tự đặt mình vào thế cưỡi lưng cọp, về sau chúng ăn quen càng có nhiều đòi hỏi rất khó làm.
(hầu hết mấyb thằng kỹ sư công trình chỉ biết học uống rượu, cfhuws cải tiến tư duy suy nghĩ thì tụi nó có đầy đủ lý do để bảo vệ chủ quan. Chỉ khi nào bạn chức vụ cao hơn chúng mới có thể nói chuyện. Mấy cái này tôi thường không nói thẳng với chúng nó mà để cho sếp tôi nói chuyện với sếp của chúng)

Nặng lời: tôi nói chuyện luôn nặng lời như vậy. Không muốn thì cứ nói thẳng ra. Tôi hứa sẽ không động chạm đến bàu nào của bạn nữa.
Đừng nói giùm người khác "nhiều người học về vba thì cũng gặp vấn đề như cháu thôi". Ngwoif hiếu học không vì mấy lời nặng nhẹ mà để tâm. Giới trẻ ngày nay hay bị lẩm lẫn giữa "hiếu học" và "đam mê". Cái "hiếu học" là trường cửu (*), cái "đam mê" là nhất thời.

Và bạn nói "vừa học vừa ứng dụng vào công việc" là quá chủ quan. Bạn chỉ ứng dụng thôi, còn học thì xa lắm. Bằng chứng là nếu học được rồi thì bác kia đã không nói câu như bài #83, và hỏi lại trong bài #85.

(*) ngày xưa, con số hoàn hảo là số 9. Ngày nay, sự hoàn hảo thay đổi bằng sự thịnh vượng (số 8). Có lẽ quan niệm xã hội vì vậy mà không còn quý trọng "trường cửu"
 
Upvote 0
VetMini đã viết:
Ứng dụng như vậy mà dùng màu là tự làm khó mình.
Nếu của mấy thằng kỹ sư công trình chúng bắt làm vậy thì là do tụi nó dốt về quản trị dữ liệu rồi bày đặt màu mè để che lấp cái lười học hỏi thêm của mình. Mà cái này thì trường hợp bạn chắc phải chịu thua. Tuy nhiên bạn phải tìm cách nói khéo với chúng là đòi hỏi này rất khó, và bạn phải nhờ nhiều chỗ mới thực hiện được. Nếu bạn ngại không nói là tự đặt mình vào thế cưỡi lưng cọp, về sau chúng ăn quen càng có nhiều đòi hỏi rất khó làm.
(hầu hết mấyb thằng kỹ sư công trình chỉ biết học uống rượu, cfhuws cải tiến tư duy suy nghĩ thì tụi nó có đầy đủ lý do để bảo vệ chủ quan. Chỉ khi nào bạn chức vụ cao hơn chúng mới có thể nói chuyện. Mấy cái này tôi thường không nói thẳng với chúng nó mà để cho sếp tôi nói chuyện với sếp của chúng)

Nặng lời: tôi nói chuyện luôn nặng lời như vậy. Không muốn thì cứ nói thẳng ra. Tôi hứa sẽ không động chạm đến bàu nào của bạn nữa.
Đừng nói giùm người khác "nhiều người học về vba thì cũng gặp vấn đề như cháu thôi". Ngwoif hiếu học không vì mấy lời nặng nhẹ mà để tâm. Giới trẻ ngày nay hay bị lẩm lẫn giữa "hiếu học" và "đam mê". Cái "hiếu học" là trường cửu (*), cái "đam mê" là nhất thời.

Và bạn nói "vừa học vừa ứng dụng vào công việc" là quá chủ quan. Bạn chỉ ứng dụng thôi, còn học thì xa lắm. Bằng chứng là nếu học được rồi thì bác kia đã không nói câu như bài #83, và hỏi lại trong bài #85.

(*) ngày xưa, con số hoàn hảo là số 9. Ngày nay, sự hoàn hảo thay đổi bằng sự thịnh vượng (số 8). Có lẽ quan niệm xã hội vì vậy mà không còn quý trọng "trường cửu"
Nhấp chuột vào đây để mở rộng...
Cháu có học chứ ạ. Bác yêu cầu cao thôi mỗi người một khả năng và tu vi khác nhau. Đấy chưa gì bác đã bảo không đụng vào bài nào của cháu. Bác là người có ảnh hưởng trong diễn đàn, bác mắng rồi không chỉ là cháu thiệt lắm rồi. Giờ các chú bác khác nhìn vào không rõ thực hư. Là cháu bắt đền bác đấy.
 
Upvote 0
Tôi đoán những bài này có liên quan đến thiết kế nội lực trong xây dựng, nhưng từ đầu đến giờ toàn nói là "bài tập". Phía trên xa bác @VetMini cũbg đã nói là không nên dùng màu để thay thế cho dữ liệu, và tôi cũng nhắc lại ý đó 1 lần: Màu chỉ có thể minh hoạ cho dữ liệu chứ không được phép thay thế dữ liệu.
Theo hiểu biết ít ỏi của tôi về thiết kế xây dựng thì sẽ có những mẫu theo tiêu chuẩn kỹ thuật khác nhau (*) và phải tuân theo (phải áp dụng trong thiết kế). Sau đó sẽ có màn thống kê theo các tiêu chuẩn này. Mỗi tiêu chuẩn sẽ có những thông số kỹ thuật đặc trưng và ở đây là 3 thông số. Ba thông số này sao không cứ để nguyên là số, rồi tô màu theo yêu cầu cấp trên hoặc theo ý thích thì tính sau.

(*) Tiêu chuẩn kỹ thuật:
- TCVN3, tiêu chuẩn châu Âu, tiêu chuẩn Mỹ, ...
- Tiêu chuẩn riêng biệt cho từng khoảng kích thước của cấu kiện
- ...
Các tiêu chuẩn này luôn luôn có những thông số.
 
Upvote 0
ptm0412 đã viết:
Tôi đoán những bài này có liên quan đến thiết kế nội lực trong xây dựng, ...
Nhấp chuột vào đây để mở rộng...
Gốc của tôi là kỹ sư công nghệ (Industrial Engineering, học ở VN). Kỹ sư công chánh (Civil Engineering, học ở ngoại quốc). Tôi làm nhiều năm trong những ngành nghề này trước khi chuyển qua CNTT.
 
Upvote 0
VetMini đã viết:
Gốc của tôi là kỹ sư công nghệ (Industrial Engineering, học ở VN). Kỹ sư công chánh (Civil Engineering, học ở ngoại quốc). Tôi làm nhiều năm trong những ngành nghề này trước khi chuyển qua CNTT.
Nhấp chuột vào đây để mở rộng...
Gốc của tôi là kế toán. Kế toán các công ty ngành nghề khác nhau thì lượm lặt mỗi ngành nghề 1 ít. Khi chuyển sang làm phân tích thiết kế phần mềm thì lượm lặt thêm 1 ít khác từ các đối tác ngành nghề khác nhau
 
Upvote 0
Cháu có ông bác nay ngoài 70 tuổi. Từ nhiều năm trước bác và những người bạn đầu bạc năm nào cũng đi chúc tết thầy giáo hơn 20 tuổi mà cháu luôn thấy ấn tượng về tình cảm đó. Nửa chữ cũng là thầy cháu luôn trân trọng sự giúp đỡ của các chú bác trên diễn đàn. Lấy lòng đã khó làm phật ý thì cực biết mấy.
Quả thật còng lưng cả tháng, đau lưng lan xuống cẳng mà vẫn chỉ sao chép lại code. Với sự giúp đỡ của chú Mỹ cháu chế đc đến 40 sub,nhưng còn nhiều nữa không biết có chế thêm đc không.
 
Lần chỉnh sửa cuối:
Upvote 0
emgaimuarao đã viết:
Cháu có ông bác nay ngoài 70 tuổi. Từ nhiều năm trước bác và những người bạn đầu bạc năm nào cũng đi chúc tết thầy giáo hơn 20 tuổi mà cháu luôn thấy ấn tượng về tình cảm đó. Nửa chữ cũng là thầy cháu luôn trân trọng sự giúp đỡ của các chú bác trên diễn đàn. Lấy lòng đã khó làm phật ý thì cực biết mấy.
Quả thật còng lưng cả tháng, đau lưng lan xuống cẳng mà vẫn chỉ sao chép lại code. Với sự giúp đỡ của chú Mỹ cháu chế đc đến 40 sub và nhưng còn nhiều nữa không biết có chế thêm đc không.
Nhấp chuột vào đây để mở rộng...
Có một số bài của bạn mình đã thử và cũng cảm thấy kết quả ổn, nhưng với ngôn ngữ giao tiếp của bạn mình thấy cũng không phù hợp với mình nên chỉ đứng ngoài thôi.
 
Upvote 0
emgaimuarao đã viết:
Lấy lòng đã khó làm phật ý thì cực biết mấy.
Nhấp chuột vào đây để mở rộng...
Chẳng cần lấy lòng gì đâu, đối với những người đã từng giúp (hoặc dạy) mà mình có tôn trọng thì khi bị mắng, trách, chê, .. phải vui vẻ mà nhận để mà rút kinh nghiệm, đừng trả lời vòng vo hoặc biện minh các kiểu. Những người lớn có kinh nghiệm họ thấy hết không nói sai đâu.
Gì mà "mẹ chưa đánh roi nào đã khóc" (thơ)
 
Upvote 0
VetMini đã viết:
Rốt cuộc thì đã rõ rồi. Phương pháp truyền đạt kiến thức của tôi không thích hợp với thớt.
Tôi xin dừng ở đây. Hết.
Nhấp chuột vào đây để mở rộng...
Hoàng Tuấn 868 đã viết:
Có một số bài của bạn mình đã thử và cũng cảm thấy kết quả ổn, nhưng với ngôn ngữ giao tiếp của bạn mình thấy cũng không phù hợp với mình nên chỉ đứng ngoài thôi.
Nhấp chuột vào đây để mở rộng...
Vâng.
Cách đây 1 tháng em không biết tẹo nào vba. Xem youtube cả tuần mà ko thu lượm đc gì đa số chế video quá cơ bản mà không lắp ghép đc.
Rồi. Vậy bó tay rồi. Nhưng file excel dùng công thức mảng thì nặng đơ luôn. Lại tìm nên diễn đàn.
Mà bây giờ hỏi gì có liên quan đến bài mà đang làm là cách học tốt nhất. Nhưng chả lẽ cứ bảo "bác ơi, chú ơi làm hộ cháu" lại ngại. Nên em chẳng biết thế nào thành ra cứ sến sến. Thật lòng cháu rất biết ơn những code của chú Mỹ.
Có lẽ kết thúc thớt này ở bài tập 5. Để tránh mất lòng người cho chữ.
 
Upvote 0
Nếu vẫn muốn học thì tại sao không trả lời 2 câu hỏi ở bài 85, mà quay sang phân bua các loại cho "mất lòng"? Giờ nếu muốn học tiếp thì trả lời đi, và rút kinh nghiệm sau này
 
Upvote 0
ptm0412 đã viết:
- Lỗi gì khi tạo skey?
- Từ vựng nào mới?
Nhấp chuột vào đây để mở rộng...
Dạ. Cháu vừa về nhà ạ.
- lỗi tạo key cháu quét vào vùng có giá trị key là không duy nhất. Cái này cháu đọc và hiểu. Key của dict phải duy nhất.
- "Từ vựng vba" là ý cháu nói về những đoạn code lý luận nối các phần trong chương trình ạ như bài #55 hay
Tmp = Dict.Item(TotalColor) 'add 1 key vào Dict với item rỗng' If Tmp <> 0 Then RArr(Tmp, 1) = RArr(Tmp, 1) + 1
- Cháu nghĩ trọng tâm code chính là tạo ra phần "từ vựng vba" ( những đoạn code lý luận) phần này học bài sơ khai càng ít có cơ hội gặp.
 
Lần chỉnh sửa cuối:
Upvote 0
emgaimuarao đã viết:
- Cháu nghĩ trọng tâm code chính là tạo ra phần "từ vựng vba" ( những đoạn code lý luận) phần này học bài sơ khai càng ít có cơ hội gặp.
Nhấp chuột vào đây để mở rộng...
Đó là cú pháp và lý luận không phải từ vựng. Từ vựng là từ chẳng hạn Do, while, until ... mới chưa từng gặp
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

Bài viết mới nhất

S
Power BI. Một quá trình đòi hỏi sự kiên nhẫn.
Trả lời
3
Đọc
138
tranhungdao12a3
T
2
  • Question Question
Hỏi cách in phiếu điều tra PCGD-XMC từ file dữ liệu mẫu xuất ra từ hệ thống PCGD-XMC của Bộ GD
    • Thích
Trả lời
15
Đọc
939
Hoàng Tuấn 868
H
SA_DQ
  • Question Question
Bài tập VBA cho những người rỗi. . . đủ thứ!
    • Cười
    • Yêu thích
Trả lời
21
Đọc
682
Phuocam
Phuocam
H
Giúp mình ghép nhiều file thành một file. (1 người xem)
Trả lời
9
Đọc
306
Hoàng Tuấn 868
H
H
  • Question Question
Dò tìm giá trị từ bảng khác theo cột
Trả lời
5
Đọc
92
ptm0412
ptm0412
L
Cách bật/tắt đèn led thứ 3 trên bàn phím cơ
Trả lời
1
Đọc
52
HUONGHCKT
H
C
Không thể group cột trong excel
Trả lời
10
Đọc
12K
ptm0412
ptm0412
A
  • Question Question
Em nhờ anh/chị/em/chú/bác giúp em viết code tổng hợp dữ liệu. em tính công thức nó nặng quá. em cám ơn
Trả lời
14
Đọc
953
Hoàng Tuấn 868
H
H
Xin giúp đỡ về phổ cập (1 người xem)
Trả lời
5
Đọc
983
tranvanky8111967
T
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
3 4 5
Trả lời
420
Đọc
51K
maingoctu89
M
P
Xin giúp sửa code VBA tổng hợp sản lượng theo format file FCS đổ từ hệ thống ERP.
Trả lời
14
Đọc
294
DeTong
D
L
Nhờ anh chị giúp đỡ công thức hàm len
Trả lời
44
Đọc
737
khuong182018
khuong182018
hongphuong1997
Cách tô màu một dòng theo chiều cao tùy ý
Trả lời
5
Đọc
192
hongphuong1997
hongphuong1997
D
nhờ anh chị giải thích hàm hstack
Trả lời
2
Đọc
138
dungpham01
D
L
Nhờ anh chị giúp giúp đỡ hàm ạ
    • Chấp nhận
Trả lời
12
Đọc
364
Phan Thế Hiệp
Phan Thế Hiệp
vuthaiha90
Lọc dữ liệu không trùng và trả kết quả về 1 dòng
Trả lời
6
Đọc
191
Duy Tùng 9x
Duy Tùng 9x
B
Copy textbox giữa 2 userform (1 người xem)
Trả lời
6
Đọc
232
Bảo_Anh_
B
L
  • Question Question
Khi chọn sheet 2, thì mặc định chọn ô A5 (1 người xem)
Trả lời
1
Đọc
104
vu_tuan_manh_linh
vu_tuan_manh_linh
ongke0711
  • Question Question
Tra cứu thông tin mã số thuế (cập nhật lại code cũ)
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
11
Đọc
812
ongke0711
ongke0711
H
Giúp đỡ Hàm tính ngày hết khấu hao, phân bổ?
Trả lời
2
Đọc
126
hitlecp
H
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom