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

Quảng cáo

ptm0412

Bad Excel Member
Thành viên BQT
Super Moderator
Tham gia ngày
4 Tháng mười một 2007
Bài viết
10,518
Được thích
30,886
Điểm
9,718
Tuổi
59
Nơi ở
Gò Vấp
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, ...
 

emgaimuarao

Thành viên hoạt động
Tham gia ngày
30 Tháng chín 2016
Bài viết
116
Được thích
29
Điểm
118
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.
 

emgaimuarao

Thành viên hoạt động
Tham gia ngày
30 Tháng chín 2016
Bài viết
116
Được thích
29
Điểm
118
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: 7
  • Dammau11-chuathemmoi.xlsm
    21 KB · Đọc: 4
  • 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:

Hoàng Nhật Phương

Thành viên tích cực
Tham gia ngày
5 Tháng mười một 2015
Bài viết
1,595
Được thích
714
Điểm
668
Nơi ở
Hà Nội
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")
 

emgaimuarao

Thành viên hoạt động
Tham gia ngày
30 Tháng chín 2016
Bài viết
116
Được thích
29
Điểm
118
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

Bad Excel Member
Thành viên BQT
Super Moderator
Tham gia ngày
4 Tháng mười một 2007
Bài viết
10,518
Được thích
30,886
Điểm
9,718
Tuổi
59
Nơi ở
Gò Vấp
- Đầ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:

emgaimuarao

Thành viên hoạt động
Tham gia ngày
30 Tháng chín 2016
Bài viết
116
Được thích
29
Điểm
118
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

Bad Excel Member
Thành viên BQT
Super Moderator
Tham gia ngày
4 Tháng mười một 2007
Bài viết
10,518
Được thích
30,886
Điểm
9,718
Tuổi
59
Nơi ở
Gò Vấp
Ở 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:

Hoàng Nhật Phương

Thành viên tích cực
Tham gia ngày
5 Tháng mười một 2015
Bài viết
1,595
Được thích
714
Điểm
668
Nơi ở
Hà Nộ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 ạ
 

emgaimuarao

Thành viên hoạt động
Tham gia ngày
30 Tháng chín 2016
Bài viết
116
Được thích
29
Điểm
118
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 ạ?
 

ptm0412

Bad Excel Member
Thành viên BQT
Super Moderator
Tham gia ngày
4 Tháng mười một 2007
Bài viết
10,518
Được thích
30,886
Điểm
9,718
Tuổi
59
Nơi ở
Gò Vấp
- 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
 

emgaimuarao

Thành viên hoạt động
Tham gia ngày
30 Tháng chín 2016
Bài viết
116
Được thích
29
Điểm
118
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:

Hoàng Nhật Phương

Thành viên tích cực
Tham gia ngày
5 Tháng mười một 2015
Bài viết
1,595
Được thích
714
Điểm
668
Nơi ở
Hà Nội

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
 

ptm0412

Bad Excel Member
Thành viên BQT
Super Moderator
Tham gia ngày
4 Tháng mười một 2007
Bài viết
10,518
Được thích
30,886
Điểm
9,718
Tuổi
59
Nơi ở
Gò Vấp
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:
Quảng cáo
Top Bottom