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:
Phải nói là trích lọc rất "cưng". Với rất nhiều điều kiện.
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
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, ...
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
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
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

  • Dammau1 1-cothemmoi.xlsm
    20.9 KB · Đọc: 8
  • Dammau11-chuathemmoi.xlsm
    21 KB · Đọc: 5
  • CountColor.jpg
    CountColor.jpg
    76 KB · Đọc: 11
  • testdemsomau.jpg
    testdemsomau.jpg
    84.9 KB · Đọc: 11
Lần chỉnh sửa cuối:
Upvote 0
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)
Bạn thử sửa dòng:
Mã:
Set SampleRng = .Range("H5:J8")
Thành:
Mã:
Set SampleRng = .Range("H5:J11")
 
Upvote 0
Bạn thử sửa dòng:
Mã:
Set SampleRng = .Range("H5:J8")
Thành:
Mã:
Set SampleRng = .Range("H5:J11")
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
- Đầ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".
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
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
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
Ở 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ú?
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

Bạn thử sửa dòng:
Mã:
Set SampleRng = .Range("H5:J8")
Thành:
Mã:
Set SampleRng = .Range("H5:J11")
Bên kia chưa xong mà lon ton qua đây bon chen
 
Lần chỉnh sửa cuối:
Upvote 0
Bên kia chưa xong mà lon ton qua đây bon chen
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
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
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 ạ
- 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
- 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 ạ?
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
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
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:

Không dễ ăn như vậy đâu Chú Mỹ ơi, khả năng đập đi xây lại Chú ạ. :yahoo:
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

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
Không dễ ăn như vậy đâu Chú Mỹ ơi, khả năng đập đi xây lại Chú ạ. :yahoo:
Đậ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
Web KT
Back
Top Bottom