mình thấy nó chỉ chuột vào đây ISup abc ()
Tắt Excel --> mở lại --> chọn Enable macro...
Có khi nào là do chưa Unblock file không anh ơi.
mình vào mạng làm theo hướng dẫn bật macro các kiểu mà vẫn chịu ko mở nổi, nhưng mà file gốc mình có khóa gì đâu
Bài này nếu không viết tắt thì đã được hỗ trợ xong lâu rồi.
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.
có bạn ạ và mình cũng làm theo hướng dẫn bật macro
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)
Đến đây thì bó tay.
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
bạn làm thêm giúp mình cho 2 cột thay cho 3 cột với nhé
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á
Chép đoạn code dưới vào file của bạn rồi test
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 Submình cảm ơn bạn nhé
