về lọc dữ liệu trùng (1 người xem)

Liên hệ QC

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

Tôi tuân thủ nội quy khi đăng bài

nguyenduylong1974

Thành viên mới
Tham gia
21/12/23
Bài viết
0
Được thích
0
mọi người giúp mình với, mình có một bảng có n số cột mỗi cột có các ô đánh số từ 0 đến 9 bây giờ mình muốn nhóm một số cột ví dụ là 3 cột chẳng hạn với yêu cầu 3 cột này trong một hàng có các số từ 0 đến 2 xuất hiện nhiều nhất và trong một hàng thì 3 cột này phải có ít nhất một cột chứa số từ 0-2, diễn tả hơi khó hiểu nhưng tóm lại là trong N số cột chứa dữ liệu ô là từ 0 đến 9 thì mình muốn lọc ra một tổ hợp cột gồm có 3 cột mà ngày nào ít nhất là 1 lần trong tổ hợp cột đấy nó cũng phải xuất hiện một số 0 hoặc 1 hoặc 2
 
mọi người giúp mình với, mình có một bảng có n số cột mỗi cột có các ô đánh số từ 0 đến 9 bây giờ mình muốn nhóm một số cột ví dụ là 3 cột chẳng hạn với yêu cầu 3 cột này trong một hàng có các số từ 0 đến 2 xuất hiện nhiều nhất và trong một hàng thì 3 cột này phải có ít nhất một cột chứa số từ 0-2, diễn tả hơi khó hiểu nhưng tóm lại là trong N số cột chứa dữ liệu ô là từ 0 đến 9 thì mình muốn lọc ra một tổ hợp cột gồm có 3 cột mà ngày nào ít nhất là 1 lần trong tổ hợp cột đấy nó cũng phải xuất hiện một số 0 hoặc 1 hoặc 2
Với "n" nhỏ, bài này dễ còn hơn ăn bánh! --=0--=0--=0
Nhưng phải có file mới tính được
 
Với "n" nhỏ, bài này dễ còn hơn ăn bánh! --=0--=0--=0
Nhưng phải có file mới tính được
Vậy mình gửi file bạn giúp mình cái nhé
Bài đã được tự động gộp:

Với "n" nhỏ, bài này dễ còn hơn ăn bánh! --=0--=0--=0
Nhưng phải có file mới tính được
Cái quan trọng là tổ hợp 3 cột được chọn ra có số ngày xuất hiện các số 0, 1, 2 là nhiều nhất (chỉ cần một cột xuất hiện một trong 3 số 0,1,2 chứ ko phải là cả 3 đều có)
Số lượng cột chỉ khoảng hơn chục cột thôi bạn ạ
 
Lần chỉnh sửa cuối:
Vậy mình gửi file bạn giúp mình cái nhé
Bài đã được tự động gộp:


Cái quan trọng là tổ hợp 3 cột được chọn ra có số ngày xuất hiện các số 0, 1, 2 là nhiều nhất (chỉ cần một cột xuất hiện một trong 3 số 0,1,2 chứ ko phải là cả 3 đều có)
Số lượng cột chỉ khoảng hơn chục cột thôi bạn ạ
Gửi file lên đi bạn
 
đây bạn ơi xem giúp mình cái
Bài đã được tự động gộp:

đây bạn ơi xem giúp mình cái
trong 15 cột đó bạn làm sao tách hoặc bạn bôi mầu cũng được một tổ hợp 3 cột mà số ngày xuất hiện số 0x hoặc 1x, 2x là nhiều nhất (số ngày xuất hiện là nhiều nhất bạn nhé chứ ko phải tổng số đâu nghĩa là trong tổ hợp 3 cột đó hàng ngày chỉ cần một cột xuất hiện 0x hoặc 1x, 2x là được) thank bạn
 

File đính kèm

Lần chỉnh sửa cuối:
Thử hàm sau:
1718188905632.png
Tìm lần max:=MAXX(
SUMMARIZE(
FILTER('Table1', 'Table1'[Value] IN {"0x", "1x", "2x"}),
'Table1'[Attribute],
"CountTT", COUNT('Table1'[TT])
),
[CountTT]
)
Số lần Max là 39, cột 9, nếu lấy 3 cột thì là 9,10,3,13
Attribute​
Tìm lần max​
Cột 1​
33​
Cột 10​
38​
Cột 11​
22​
Cột 12​
24​
Cột 13​
34​
Cột 14​
26​
Cột 15​
25​
Cột 2​
29​
Cột 3​
34​
Cột 4​
27​
Cột 5​
24​
Cột 6​
32​
Cột 7​
33​
Cột 8​
22​
Cột 9​
39​
Grand Total​
39​
 

File đính kèm

đây bạn ơi xem giúp mình cái
Bài đã được tự động gộp:



trong 15 cột đó bạn làm sao tách hoặc bạn bôi mầu cũng được một tổ hợp 3 cột mà số ngày xuất hiện số 0x hoặc 1x, 2x là nhiều nhất (số ngày xuất hiện là nhiều nhất bạn nhé chứ ko phải tổng số đâu nghĩa là trong tổ hợp 3 cột đó hàng ngày chỉ cần một cột xuất hiện 0x hoặc 1x, 2x là được) thank bạn
Solver Excel bị giới hạn nên với mô hình của bạn chỉ chạy được cho 101 dòng.

Kết quả với bài này: số cột nhỏ nhất đáp ứng yêu cầu chỉ có thể là = 6
---

Cho cột R1:AF1 = 1 rồi chạy solver trong menu data
 
Bạn ơi mình ko biết nhiều về excel , mình mở ra thì như bạn làm chưa đúng mục đích của mình, mình muốn bạn tìm cho mình 3 cột mình ví dụ bạn tìm ra cột 3.8.9 chả hạn mà 3 cột này trong mỗi hàng phải sự xuất hiện của 0 hoặc 1,2 là đều nhất, không cần phải 3 cột 3.8.9 cùng phải có chỉ cần một cột có thôi nhưng sô hàng nà nó có là nhiều nhất trong tổ hợp 3 cột của 15 cột bạn ạ
Bài đã được tự động gộp:

Bạn ơi mình ko biết nhiều về excel , mình mở ra thì như bạn làm chưa đúng mục đích của mình, mình muốn bạn tìm cho mình 3 cột mình ví dụ bạn tìm ra cột 3.8.9 chả hạn mà 3 cột này trong mỗi hàng phải sự xuất hiện của 0 hoặc 1,2 là đều nhất, không cần phải 3 cột 3.8.9 cùng phải có chỉ cần một cột có thôi nhưng sô hàng nà nó có là nhiều nhất trong tổ hợp 3 cột của 15 cột bạn ạ
3 cột cố định có sự xuất hiện đều nhất bạn nhé
Bài đã được tự động gộp:

Bạn ơi mình ko biết nhiều về excel , mình mở ra thì như bạn làm chưa đúng mục đích của mình, mình muốn bạn tìm cho mình 3 cột mình ví dụ bạn tìm ra cột 3.8.9 chả hạn mà 3 cột này trong mỗi hàng phải sự xuất hiện của 0 hoặc 1,2 là đều nhất, không cần phải 3 cột 3.8.9 cùng phải có chỉ cần một cột có thôi nhưng sô hàng nà nó có là nhiều nhất trong tổ hợp 3 cột của 15 cột bạn ạ
Bài đã được tự động gộp:


3 cột cố định có sự xuất hiện đều nhất bạn nhé
có thể 3 cột đấy chưa chắc là 3 cột có tổng số lượng nhiều nhất mà là số ngày xuất hiện 0 hoặc 1.2 của 3 cột đấy là nhiều nhất trong n tổ hợp 3 cột của 15 cột
Bài đã được tự động gộp:

''Số lần Max là 39, cột 9, nếu lấy 3 cột thì là 9,10,3,13'' cột 9.10.3.13 chỉ là số cột có các số 0 hoặc 1.2 nhiều nhất thôi , về lý thuyết thì càng nhiều thì sẽ xuất hiện trùng càng nhiều, tuy nhiên để sắp sếp một tổ hợp 3 cột mà ngày nào cũng xuất hiện ít nhất 1 lần 0 hoặc 1.2 thì chưa phải bạn ạ
 
Lần chỉnh sửa cuối:
Bạn ơi mình ko biết nhiều về excel , mình mở ra thì như bạn làm chưa đúng mục đích của mình, mình muốn bạn tìm cho mình 3 cột mình ví dụ bạn tìm ra cột 3.8.9 chả hạn mà 3 cột này trong mỗi hàng phải sự xuất hiện của 0 hoặc 1,2 là đều nhất, không cần phải 3 cột 3.8.9 cùng phải có chỉ cần một cột có thôi nhưng sô hàng nà nó có là nhiều nhất trong tổ hợp 3 cột của 15 cột bạn ạ
Bài đã được tự động gộp:


3 cột cố định có sự xuất hiện đều nhất bạn nhé
Bài đã được tự động gộp:


có thể 3 cột đấy chưa chắc là 3 cột có tổng số lượng nhiều nhất mà là số ngày xuất hiện 0 hoặc 1.2 của 3 cột đấy là nhiều nhất trong n tổ hợp 3 cột của 15 cột
Bài đã được tự động gộp:

''Số lần Max là 39, cột 9, nếu lấy 3 cột thì là 9,10,3,13'' cột 9.10.3.13 chỉ là số cột có các số 0 hoặc 1.2 nhiều nhất thôi , về lý thuyết thì càng nhiều thì sẽ xuất hiện trùng càng nhiều, tuy nhiên để sắp sếp một tổ hợp 3 cột mà ngày nào cũng xuất hiện ít nhất 1 lần 0 hoặc 1.2 thì chưa phải bạn ạ
Bạn đang nói gì vậy???
 
Bạn đang nói gì vậy???
mình bảo mình ko biết nhiều về excel bạn ạ, mình chỉ biết ít hàm đơn giản thôi, bạn có thể tách riêng cho mình 3 cái cột cố định có số lượng xuất hiện 0 hoạc 1.2 nhiều nhất, có thể bạn chưa hiểu rõ ý của mình nên bạn lấy 3 cột có tổng số xuất hiện nhiều nhất nhưng ý mình là cái tổ hợp đấy chỉ cần 1 cột có 0 hoạc 1.2 xuất hiện trong các hàng thôi nhưng nó là nhiều nhất trong các tổ hợp cột
Bài đã được tự động gộp:

Bạn đang nói gì vậy???
hi, mình ko có ý gì đâu, còn chưa cảm ơn bạn mà :)
 
đây bạn ơi xem giúp mình cái
Bài đã được tự động gộp:



trong 15 cột đó bạn làm sao tách hoặc bạn bôi mầu cũng được một tổ hợp 3 cột mà số ngày xuất hiện số 0x hoặc 1x, 2x là nhiều nhất (số ngày xuất hiện là nhiều nhất bạn nhé chứ ko phải tổng số đâu nghĩa là trong tổ hợp 3 cột đó hàng ngày chỉ cần một cột xuất hiện 0x hoặc 1x, 2x là được) thank bạn
Chạy code tô màu 3 cột thỏa điều kiện
Mã:
Sub abc()
  Dim arr(), res(1 To 3), sR&, sC&, i&, j&, j2&, j3&, k&, rMax&
  Const dk$ = "0x1x2x"
 
  i = Range("A1000000").End(xlUp).Row
  j = Range("A1").End(xlToRight).Column
  arr = Range("B2", Cells(i, j)).Value
  sR = UBound(arr): sC = UBound(arr, 2)
  For j = 1 To sC
    For j2 = j + 1 To sC
      For j3 = j2 + 1 To sC
        k = 0
        For i = 1 To sR
          If InStr(1, dk, arr(i, j)) Or InStr(1, dk, arr(i, j2)) Or InStr(1, dk, arr(i, j3)) Then k = k + 1
        Next i
        If rMax < k Then
          rMax = k
          res(1) = j:     res(2) = j2:   res(3) = j3
        End If
      Next j3
    Next j2
  Next j

  Range("B1").Resize(, sC).Interior.Pattern = xlNone
  For j = 1 To 3
    Cells(1, res(j) + 1).Interior.Color = 49407
  Next j
  MsgBox ("So Dong Thoa Dieu Kien La:  " & rMax)
End Sub
 
Lần chỉnh sửa cuối:
Viết hàm sau:
1718202426308.png
Tìm lần max2:=MAXX(
UNION(
SUMMARIZE(
FILTER('Table1', 'Table1'[Value] = "0x"),
'Table1'[Attribute],
"CountTT", COUNT('Table1'[TT])
),
SUMMARIZE(
FILTER('Table1', 'Table1'[Value] = "1x"),
'Table1'[Attribute],
"CountTT", COUNT('Table1'[TT])
),
SUMMARIZE(
FILTER('Table1', 'Table1'[Value] = "2x"),
'Table1'[Attribute],
"CountTT", COUNT('Table1'[TT])
)
),
[CountTT]
)
Hàm này sẽ cho biết cột nào có 0x hoặc 1x hoặc 2x là lớn nhất.
Sẽ tìm được các cột: 3,6,7,9,10
1718202542548.png
Thường những bài viết loằng ngoằng khó hiểu tôi ngại đọc và viết, trót viết rồi nên viết nốt!
 
mình cảm ơn bạn nhiều, bạn có thể gửi file kết quả này ''Chạy code tô màu 3 cột thỏa điều kiện'' cho mình thì tốt quá
 
mình cảm ơn bạn nhiều, bạn có thể gửi file kết quả này ''Chạy code tô màu 3 cột thỏa điều kiện'' cho mình thì tốt quá
Bạn chịu khó tìm hiểu cách gán code vba vào file Excel mà sử dụng, còn lâu dài về sau nữa. (trên mạng rất nhiều bài hướng dẫn chi tiết). Chứ đã nấu hộ cơm rồi mà vẫn không tìm được cách ăn nữa thì ...chán quá.
 
Bạn chịu khó tìm hiểu cách gán code vba vào file Excel mà sử dụng, còn lâu dài về sau nữa. (trên mạng rất nhiều bài hướng dẫn chi tiết). Chứ đã nấu hộ cơm rồi mà vẫn không tìm được cách ăn nữa thì ...chán quá.
thế mình mới nói là mình ko biết nhiều excel mà bạn, mình còn ko hiểu VBA là gì, công việc mình chỉ làm với vài hàm excel thông thường thôi, giờ mình đang cần một bài toán như vậy nên cần sự giúp đỡ
 
thế mình mới nói là mình ko biết nhiều excel mà bạn, mình còn ko hiểu VBA là gì, công việc mình chỉ làm với vài hàm excel thông thường thôi, giờ mình đang cần một bài toán như vậy nên cần sự giúp đỡ
Làm tuần tự như sau:
Copy "cốt" bài trên --> mở file --> nhấn alt+F11 --> nhấn alt + I + M --> nhấn ctrl + V --> nhấn alt + Q. Đến đây là xong phần chèn "cốt"
Chọn sheet cần tính toán --> nhấn alt + F8 --> chọn macro có tên như "cốt" bài trên --> nhấn chọn "Run" hoặc enter để chạy "cốt" --> xem kết quả
 
Làm tuần tự như sau:
Copy "cốt" bài trên --> mở file --> nhấn alt+F11 --> nhấn alt + I + M --> nhấn ctrl + V --> nhấn alt + Q. Đến đây là xong phần chèn "cốt"
Chọn sheet cần tính toán --> nhấn alt + F8 --> chọn macro có tên như "cốt" bài trên --> nhấn chọn "Run" hoặc enter để chạy "cốt" --> xem kết quả
Còn phần lưu code và định dạng file nữa anh ơi.
 
Làm tuần tự như sau:
Copy "cốt" bài trên --> mở file --> nhấn alt+F11 --> nhấn alt + I + M --> nhấn ctrl + V --> nhấn alt + Q. Đến đây là xong phần chèn "cốt"
Chọn sheet cần tính toán --> nhấn alt + F8 --> chọn macro có tên như "cốt" bài trên --> nhấn chọn "Run" hoặc enter để chạy "cốt" --> xem kết quả
Mình cảm ơn bạn, mình đang ngoài công trường, nên chưa thực hành được, về mình làm có gì vướng lại nhờ bạn chỉ dẫn sau nhé.
 
mình làm theo đúng trình tự đến đây thì gặp lỗi này làm đi làm lại vẫn thế
 

File đính kèm

  • Ảnh chụp màn hình 2024-06-13 210837.png
    Ảnh chụp màn hình 2024-06-13 210837.png
    89.2 KB · Đọc: 17
mình thấy nó chỉ chuột vào đây ISup abc ()
Bài đã được tự động gộp:

bạn làm file excel rồi gửi cho mình xin thì tốt quá, mình ko biết gì về cái món này giờ tuổi nhiều mò mẫm mệt quá
Đây bạn. Nhấn alt + F8 để chạy
Cái "cốt" trong file của @HieuCD nhé bạn
 

File đính kèm

ko biết có phải tại máy mình ko nhỉ nó vẫn báo lỗi thế bạn ạ
Bài đã được tự động gộp:

hay do mình đang mở nhiều file excel?
Bài đã được tự động gộp:

mình làm lại alt + f8 thì nó ra thế này
Bài đã được tự động gộp:

thông cảm mình nhé, phiền bạn quá
 

File đính kèm

  • Ảnh chụp màn hình 2024-06-13 213926.png
    Ảnh chụp màn hình 2024-06-13 213926.png
    94.5 KB · Đọc: 14
  • Ảnh chụp màn hình 2024-06-13 214601.png
    Ảnh chụp màn hình 2024-06-13 214601.png
    60.9 KB · Đọc: 14
Lần chỉnh sửa cuối:
ko biết có phải tại máy mình ko nhỉ nó vẫn báo lỗi thế bạn ạ
Bài đã được tự động gộp:

hay do mình đang mở nhiều file excel?
Bài đã được tự động gộp:

mình làm lại alt + f8 thì nó ra thế này
Bài đã được tự động gộp:

thông cảm mình nhé, phiền bạn quá
Tắt Excel --> mở lại --> chọn Enable macro...
 
mình không hiểu bạn ạ? thực sự là mình rất cần mình ko biết gì về VBA gì cả mình chỉ muốn nhờ bạn nào làm giúp cho mình file excel để mình lọc thôi nhưng cái ý tưởng cũng khó diễn đạt nên mình viết hơi dài thôi
 
Lần chỉnh sửa cuối:
@nguyenduylong1974

Bạn dùng excel phiên bản nào?
Khi mở file có thấy yêu cầu Enable macro... hay không?
 
@nguyenduylong1974

Bạn dùng excel phiên bản nào?
Khi mở file có thấy yêu cầu Enable macro... hay không?
có bạn ạ và mình cũng làm theo hướng dẫn bật macro
Bài đã được tự động gộp:

Có lẽ bác là 1974, và bác diễn đạt cứ như là toán đố ấy, em vẫn chưa hiểu bài toán * này!!! Bác càng giải thích càng nâng mức độ khó lên thêm nữa.
Do đó, em đoán mò 3 cột này 7 9 10:

View attachment 301696
3 cột 7.9.10 có các hàng bôi màu vàng đạt yêu cầu (có xuất hiện 0x hoặc 1x , 2x) và mục đích là lọc tìm trong rất nhiều tổ hợp 3 cột một tổ hợp có các hàng được bôi màu vàng nhiều nhất. (mình đã ẩn đi cột 8 để sếp 3 cột 7.9.10 gần nhau cho dễ nhìn)
 

File đính kèm

  • Ảnh chụp màn hình 2024-06-14 120727.png
    Ảnh chụp màn hình 2024-06-14 120727.png
    252.6 KB · Đọc: 12
Lần chỉnh sửa cuối:
Đến đây thì bó tay.
Có lẽ tốt nhất bạn dịch nội dung cảnh báo để lựa chọn cách

xử lý cho ph

Đến đây thì bó tay.
Có lẽ tốt nhất bạn dịch nội dung cảnh báo để lựa chọn cách xử lý cho phù hợp!!
Alo bạn CHAOQUAY, mình làm được rồi bạn ạ, mình phải nhờ đứa cháu nó mở chặn ở cấu hình máy tính chứ ko phải chỉ ở excel , tiện cái file bạn đã làm cho mình, mình muốn nhờ bạn làm thêm cho mình 1 file tổ hợp của 2 cột thay cho 3 cột bạn đã làm có được không , mình cảm ơn
 
Chạy code tô màu 3 cột thỏa điều kiện
Mã:
Sub abc()
  Dim arr(), res(1 To 3), sR&, sC&, i&, j&, j2&, j3&, k&, rMax&
  Const dk$ = "0x1x2x"
 
  i = Range("A1000000").End(xlUp).Row
  j = Range("A1").End(xlToRight).Column
  arr = Range("B2", Cells(i, j)).Value
  sR = UBound(arr): sC = UBound(arr, 2)
  For j = 1 To sC
    For j2 = j + 1 To sC
      For j3 = j2 + 1 To sC
        k = 0
        For i = 1 To sR
          If InStr(1, dk, arr(i, j)) Or InStr(1, dk, arr(i, j2)) Or InStr(1, dk, arr(i, j3)) Then k = k + 1
        Next i
        If rMax < k Then
          rMax = k
          res(1) = j:     res(2) = j2:   res(3) = j3
        End If
      Next j3
    Next j2
  Next j

  Range("B1").Resize(, sC).Interior.Pattern = xlNone
  For j = 1 To 3
    Cells(1, res(j) + 1).Interior.Color = 49407
  Next j
  MsgBox ("So Dong Thoa Dieu Kien La:  " & rMax)
End Sub
bạn làm thêm giúp mình cho 2 cột thay cho 3 cột với nhé
 
Alo bạn CHAOQUAY, mình làm được rồi bạn ạ, mình phải nhờ đứa cháu nó mở chặn ở cấu hình máy tính chứ ko phải chỉ ở excel , tiện cái file bạn đã làm cho mình, mình muốn nhờ bạn làm thêm cho mình 1 file tổ hợp của 2 cột thay cho 3 cột bạn đã làm có được không , mình cảm ơn
Chốt lại là mục tiêu mong muốn của bạn là gì?
 
Chốt lại là mục tiêu mong muốn của bạn là gì?
Mình đã mở được flie bạn làm cho mình 3 cột rồi, nếu bạn có thể làm giúp mình thêm được 1 file như hôm trước bạn làm cho mình nhưng lọc với 2 cột thì tốt quá
Bài đã được tự động gộp:

hôm trước nhờ các bạn trên này làm 3 cột vì định làm thủ công 2 cột ghép với nhau nhưng nó chiếm nhiều cột quá nên muốn nhờ bạn giúp nốt lọc với 2 cột
 
Bạn CHAOQUAY hộ mình thêm lần nữa nhé, cảm ơn bạn
Chép đoạn code dưới vào file của bạn rồi test

Số lượng cột có thể thay đổi tại dòng chỉ dẫn
Nếu số lượng dòng, cột yêu cầu là lớn, có thể code sẽ chạy chậm, cái này chưa test nhé

Kết quả điền vào sheet1, R1
Mã:
Option Explicit

Sub tohop()
Dim Nguon
Dim mTK() As Long
Dim slCot
Dim mTam
Dim chap, trs, maxGT
Dim Kq
Dim rws, cls
Dim i, j, k, x, z, t

Nguon = Sheet1.Range("B2", Sheet1.Range("P2").End(xlDown))
rws = UBound(Nguon)
cls = UBound(Nguon, 2)
mTam = Array("0x", "1x", "2x") '<<<----- Nhap so muon loc vao day

ReDim mTK(1 To rws, 1 To cls)
For i = 1 To rws
    For j = 1 To cls
        k = Filter(mTam, Nguon(i, j))
        If UBound(k) = 0 Then mTK(i, j) = 1
    Next j
Next i

'************************************************
slCot = 3 '<<<----- Nhap so cot mong muon vao day
If slCot < 2 Or slCot >= cls Then
    MsgBox "Nhap lai so luong cot"
    Exit Sub
End If
'************************************************

With CreateObject("Scripting.Dictionary")
    ReDim k(slCot)
    k(1) = 1
    .Item(0) = k
    For chap = 2 To slCot
        If chap = slCot Then maxGT = 0
        mTam = .Items
        .RemoveAll
        For i = 0 To UBound(mTam)
            k = mTam(i)(chap - 1)
            For j = k + 1 To cls - (slCot - chap)
                mTam(i)(chap) = j
                trs = 0
                For x = 1 To rws
                    t = 0
                    For z = 1 To chap
                        t = t + mTK(x, mTam(i)(z))
                    Next z
                    If t Then trs = trs + 1
                Next x
                mTam(i)(0) = trs
                .Item(.Count) = mTam(i)
                If chap = slCot Then
                    If maxGT < trs Then maxGT = trs
                End If
            Next j
        Next i
    Next chap
    For Each k In .Keys
        If CLng(.Item(k)(0)) < maxGT Then .Remove k
    Next k
    ReDim Kq(1 To .Count, 1 To slCot)
    For i = 0 To .Count - 1
        For j = 1 To slCot
            Kq(i + 1, j) = .Items()(i)(j)
        Next j
    Next i
End With

With Sheet1
    .Range("R1").Resize(UBound(Kq) + 1, cls).Clear
    .Range("R1") = maxGT
    .Range("R2").Resize(UBound(Kq), UBound(Kq, 2)) = Kq
End With
End Sub
 
Lần chỉnh sửa cuối:
Chép đoạn code dưới vào file của bạn rồi test

Số lượng cột có thể thay đổi tại dòng chỉ dẫn
Nếu số lượng dòng, cột yêu cầu là lớn, có thể code sẽ chạy chậm, cái này chưa test nhé

Kết quả điền vào sheet1, R1
Mã:
Option Explicit

Sub tohop()
Dim Nguon
Dim mTK() As Long
Dim slCot
Dim mTam
Dim chap, trs, maxGT
Dim Kq
Dim rws, cls
Dim i, j, k, x, z, t

Nguon = Sheet1.Range("B2", Sheet1.Range("P2").End(xlDown))
rws = UBound(Nguon)
cls = UBound(Nguon, 2)
mTam = Array("0x", "1x", "2x") '<<<----- Nhap so muon loc vao day

ReDim mTK(1 To rws, 1 To cls)
For i = 1 To rws
    For j = 1 To cls
        k = Filter(mTam, Nguon(i, j))
        If UBound(k) = 0 Then mTK(i, j) = 1
    Next j
Next i

'************************************************
slCot = 3 '<<<----- Nhap so cot mong muon vao day
If slCot < 2 Or slCot >= cls Then
    MsgBox "Nhap lai so luong cot"
    Exit Sub
End If
'************************************************

With CreateObject("Scripting.Dictionary")
    ReDim k(slCot)
    k(1) = 1
    .Item(0) = k
    For chap = 2 To slCot
        If chap = slCot Then maxGT = 0
        mTam = .Items
        .RemoveAll
        For i = 0 To UBound(mTam)
            k = mTam(i)(chap - 1)
            For j = k + 1 To cls - (slCot - chap)
                mTam(i)(chap) = j
                trs = 0
                For x = 1 To rws
                    t = 0
                    For z = 1 To chap
                        t = t + mTK(x, mTam(i)(z))
                    Next z
                    If t Then trs = trs + 1
                Next x
                mTam(i)(0) = trs
                .Item(.Count) = mTam(i)
                If chap = slCot Then
                    If maxGT < trs Then maxGT = trs
                End If
            Next j
        Next i
    Next chap
    For Each k In .Keys
        If CLng(.Item(k)(0)) < maxGT Then .Remove k
    Next k
    ReDim Kq(1 To .Count, 1 To slCot)
    For i = 0 To .Count - 1
        For j = 1 To slCot
            Kq(i + 1, j) = .Items()(i)(j)
        Next j
    Next i
End With

With Sheet1
    .Range("R1").Resize(UBound(Kq) + 1, cls).Clear
    .Range("R1") = maxGT
    .Range("R2").Resize(UBound(Kq), UBound(Kq, 2)) = Kq
End With
End Sub
mình cảm ơn bạn nhé
 

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

Back
Top Bottom