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 · 12/2/21

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.

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

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

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

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.

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

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

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)

Hoàng Nhật Phương · 16/2/21

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)

Bạn thử sửa dòng:

Mã:

Set SampleRng = .Range("H5:J8")

Thành:

Mã:

Set SampleRng = .Range("H5:J11")

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

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")

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

ptm0412 · 16/2/21

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

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

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

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

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ú?

ptm0412 · 16/2/21

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ú?

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")

Bên kia chưa xong mà lon ton qua đây bon chen

Hoàng Nhật Phương · 16/2/21

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

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

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

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 ạ

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

ptm0412 · 16/2/21

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

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

Hoàng Nhật Phương · 16/2/21

ptm0412 đã viết:
...
If Tmp <> 0 Then RArr(Tmp, 1) = RArr(Tmp, 1) + 1
...

Không dễ ăn như vậy đâu Chú Mỹ ơi, khả năng đập đi xây lại Chú ạ. :yahoo:

ptm0412 · 16/2/21

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ú ạ.

Test đi kưng. Chú tét rồi

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

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

- 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: 16/2/21

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ú ạ.

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ỉ?

ptm0412 · 16/2/21

emgaimuarao đã viết:
cái phần trồi #N/A kia cũng xử lý được luôn phải không ạ.

Này thì xử lý trồi

Hoàng Nhật Phương · 16/2/21

ptm0412 đã viết:
Test đi kưng. Chú tét rồi

View attachment 254202

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ú:

ptm0412 · 16/2/21

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ú ạ.

Đậ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

Hoàng Nhật Phương · 16/2/21

ptm0412 đã viết:
Này thì xử lý trồi

View attachment 254207

Chưa được đâu Chú Mỹ ơi, thay #NA đó nó phải ra số cơ :yahoo:

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

ptm0412 đã viết:
Này thì xử lý trồi

View attachment 254207

Đú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ị?

ptm0412 · 16/2/21

Hoàng Nhật Phương đã viết:
Chưa được đâu Chú Mỹ ơi, thay #NA đó nó phải ra số cơ

Pậy pạ nà. Bỏ cái trồi trồi đó là xong rồi

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

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

File đính kèm

Thành viên gắn bó

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 gắn bó

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

Bad Excel Member

Thành viên gắn bó

Bad Excel Member

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

Bad Excel Member

Thành viên gắn bó

Bad Excel Member

Thành viên gắn bó

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

Bad Excel Member