|
Option Explicit
Sub TEST5()
Dim vResult, ar, br, cr, i&, j&
ar = Range("D1", Cells(Rows.Count, "D").End(xlUp)).Value
ReDim vResult(1 To UBound(ar), 0)
ReDim cr(1 To 3)
For i = 1 To UBound(ar)
If Len(ar(i, 1)) Then
ReDim br(1 To Len(ar(i, 1)), 1 To 1)
For j = 1 To UBound(br)
br(j, 1) = Mid(ar(i, 1), j, 1)
Next j
For j = 1 To UBound(cr)
cr(j) = br
Next j
vResult(i, 0) = Join(cartesianProduct3(cr))
End If
Next i
Columns("E").ClearContents
[E1].Resize(UBound(vResult)) = vResult
Beep
End Sub
Function cartesianProduct3(ByVal ar) As Variant
Dim br&(), cr, vResult(), iGroup&, i&, j&, m&, n&, x&
n = UBound(ar)
For i = 1 To UBound(ar)
m = m + UBound(ar(i), 2)
Next i
ReDim br(1 To n)
ReDim cr(1 To m)
For j = 1 To n: br(j) = 1: Next
iGroup = 0
Do
x = 0
For j = 1 To n
For i = 1 To UBound(ar(j), 2)
x = x + 1
cr(x) = ar(j)(br(j), i)
Next i
Next
iGroup = iGroup + 1
ReDim Preserve vResult(1 To iGroup)
vResult(iGroup) = Join(cr, "")
For j = n To 1 Step -1
br(j) = br(j) + 1
If br(j) <= UBound(ar(j)) Then Exit For Else br(j) = 1
Next
Loop Until j = 0
cartesianProduct3 = vResult
End Function
|
评分
-
1
查看全部评分
-
|