|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
本帖最后由 jyin218 于 2023-12-26 00:23 编辑
1.从1.2.3.4.5.6.7.8.9.10.11.12
中选3个,进行组合。
2.将这些组合4个为一组进行搭配。
3.搭配后每组都包含1.2.3.4.5.6.7.8.9.10.11.12。
求实现excelVBA代码。
Sub Combination()
Dim i As Long, j As Long, k As Long
Dim arr() As Variant
Dim count As Long
Dim tempArr() As Variant
Dim output() As Variant
Dim allNums As Variant
' 初始化数字数组
allNums = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12)
' 生成所有可能的3数字组合
ReDim arr(1 To 12, 1 To 20000)
count = 0
For i = 1 To 12
For j = i + 1 To 12
For k = j + 1 To 12
count = count + 1
arr(count, 1) = allNums(i)
arr(count, 2) = allNums(j)
arr(count, 3) = allNums(k)
Next k
Next j
Next i
' 对每4个组合进行搭配,确保每组包含所有数字
Do While UBound(arr, 1) > 0
tempArr = RemoveDuplicates(arr)
If UBound(tempArr, 1) >= 4 Then
output = output & "(" & Join(tempArr, ",") & ")" & ","
End If
arr = tempArr: ReDim arr(1 To UBound(arr, 1))
Loop
output = Left(output, Len(output) - 1) ' 去掉最后一个多余的逗号
MsgBox "可能的组合为:" & output
End Sub
Function RemoveDuplicates(arr() As Variant) As Variant()
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Dim i As Long, output() As Variant
ReDim output(1 To UBound(arr, 1))
For i = LBound(arr, 1) To UBound(arr, 1) - 1
If Not dict.Exists(arr(i, 1)) Then
dict.Add Key:=arr(i, 1), Item:=True ' 只检查第一列,因为每一行都不同
output(dict.Count) = arr(i, 1) & "," & arr(i, 2) & "," & arr(i, 3) & "," & arr(i+1, 1) & "," & arr(i+2, 2) & "," & arr(i+3, 3)
End If
Next i
RemoveDuplicates = output
End Function
以上代码实现不了,请求检查指导,谢谢。
|
|