Private Declare Function GetTickCount Lib "kernel32.dll" () As Long
Function Combination(Arr(), result()) As Boolean
' Arr là mảng chứa dữ liệu, không nhất thiết các ôđều có dữ liệu. Vd. mảng 3x3 với các dòng là
' dòng 1: A1, B1, C1
' dòng 2: A2 , B2, C2
' dòng 3: <trống>, B3, <trống>
' Điều kiện bắt buộc mà mảng phải thỏa: Trong mỗi cột các ôcó dữ liệu phải liên tục bắt đầu từ ôđầu tiên. Mỗi cột phải có ít nhất 1 ôdữ liệu
' result là mảng chứa kêt quả trả về.
' Nếu mảng có k cột và gọi s(k) là số ôcó dữ liệu trong cột k thì mảng trả về có s(1)*s(2)*...*s(k) dòng
' Với vd. ở trên thì có 12 dòng kết quả
' A1 , B1, C1
' A1 , B1, C2
' A1 , B2, C1
' A1 , B2, C2
' A1 , B3, C1
' A1 , B3, C2
' A2 , B1, C1
' A2 , B1, C2
' A2 , B2, C1
' A2 , B2, C2
' A2 , B3, C1
' A2 , B3, C2
' Nếu cột nào đó không có dữ liệu thì hàm trả về FALSE và không có kết quả trả về trong mảng result
Dim tmp(), index(), k As Long, r As Long, c As Long, count As Long
tmp = Arr
' dong 1 cua mang index ghi so phan tu trong moi cot
ReDim index(1 To 2, 1 To UBound(tmp, 2))
count = 1
For c = UBound(tmp, 2) To 1 Step -1
If c = UBound(tmp, 2) Then
index(2, c) = 1
Else
index(2, c) = index(1, c + 1) * index(2, c + 1)
End If
For r = UBound(tmp) To 1 Step -1
If tmp(r, c) <> "" Then
index(1, c) = r
count = count * r
Exit For
End If
Next
If r = 0 Then GoTo end_
Next
' xác định các kết quả
ReDim result(1 To count, 1 To UBound(tmp, 2))
For r = 1 To count
For c = 1 To UBound(result, 2)
k = (r - 1) \ index(2, c)
k = (k Mod index(1, c)) + 1
result(r, c) = tmp(k, c)
Next
Next
Combination = True
end_:
End Function
Sub test()
Dim Arr(), result(), t As Double
t = GetTickCount
Arr = Range("A3:E19")
If Combination(Arr, result) Then
Debug.Print (GetTickCount - t) / 1000
Range("H3").Resize(UBound(result), UBound(result, 2)).Value = result
End If
End Sub
12], [E1:E42]
