|
ublic arr1(1 To 65536, 1 To 1), z
Sub peng()
Dim arr2(1 To 65536, 1 To 1)
l = 2
arr = Range("A1:A" & [A65536].End(xlUp).Row)
xi arr, ",", UBound(arr)
For i = 1 To z
arr = Split(arr1(i, 1), ",")
ren arr, 1, UBound(arr) - 1, ar
For j = 1 To UBound(ar)
zz = zz + 1
arr2(zz, 1) = ar(j)
If zz = 65536 Then
Cells(1, l).Resize(zz, 1) = arr2
zz = 0
l = l + 1
End If
Next
Next i
Cells(1, l).Resize(zz, 1) = arr2 '得到所有数的组合
End Sub
Sub xi(arr, s, j) 'S代表位置
If j = 0 Then
z = z + 1
arr1(z, 1) = s
Exit Sub
End If
For i = 1 To UBound(arr)
If Not s Like "*," & arr(i, 1) & ",*" Then '得到所有数的组合
xi arr, s & arr(i, 1) & ",", j - 1
End If
Next i
End Sub
Sub ren(arr, a, b, ar)
ReDim ar(1 To 1)
If a = b Then ar(1) = arr(a): Exit Sub
y = 0
For i = a To b - 1
ren arr, a, i, ar1
ren arr, i + 1, b, ar2
ReDim Preserve ar(1 To y + UBound(ar1) * UBound(ar2) * 4)
For ii = 1 To UBound(ar1)
For jj = 1 To UBound(ar2)
y = y + 1
ar(y) = "(" & ar1(ii) & "*" & ar2(jj) & ")"
y = y + 1
ar(y) = "(" & ar1(ii) & "/" & ar2(jj) & ")"
y = y + 1
ar(y) = "(" & ar1(ii) & "+" & ar2(jj) & ")"
y = y + 1
ar(y) = "(" & ar1(ii) & "-" & ar2(jj) & ")"
Next
Next
Next i
End Sub
|
|