获取求和数的所有组合

Question

sheet1 中的 A 列的值 [1,2,3,4,5,6] 在 range("A1:A6") 中，我想要做的是获取每两个数字相加的所有组合每三个数字 每四个数字 每五个数字 这是我到现在为止所做的，但结果并不像我预期的那样

Sub Test()
    Dim a, b, lr As Long, i As Long, j As Long, k As Long, ii As Long
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To lr
        For j = i To lr
            For ii = j To lr
                Cells(i, ii + 1) = i & "+" & j & "+" & ii & "=" & i + j + ii
            Next ii
        Next j
    Next i
    With Range("A1").CurrentRegion
        a = .Offset(, 1).Resize(, .Columns.Count - 1).Value
        ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To 1)
        For i = LBound(a) To UBound(a)
            For j = LBound(a, 2) To UBound(a, 2)
                If a(i, j) <> "" Then
                    k = k + 1
                    b(k, 1) = a(i, j)
                End If
            Next j
        Next i
        .Cells(1, .Columns.Count + 2).Resize(k).Value = b
    End With
End Sub

所需输出的示例： 每两个数字在一起>>

Sub Test()
    Dim a, b, lr As Long, i As Long, j As Long, k As Long, ii As Long
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To lr
        For j = i To lr
            Cells(i, j + 1) = i & "+" & j & "=" & i + j
        Next j
    Next i
    With Range("A1").CurrentRegion
        a = .Offset(, 1).Resize(, .Columns.Count - 1).Value
        ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To 1)
        For i = LBound(a) To UBound(a)
            For j = LBound(a, 2) To UBound(a, 2)
                If a(i, j) <> "" Then
                    k = k + 1
                    b(k, 1) = a(i, j)
                End If
            Next j
        Next i
        .Cells(1, .Columns.Count + 2).Resize(k).Value = b
    End With
End Sub

结果将类似于 J 列中的结果

1+1=2
1+2=3
1+3=4
1+4=5
1+5=6
1+6=7
2+2=4
2+3=5
2+4=6
2+5=7
2+6=8
3+3=6
3+4=7
3+5=8
3+6=9
4+4=8
4+5=9
4+6=10
5+5=10
5+6=11
6+6=12

这对于每两个数字都可以。我怎样才能得到每三个数字、每四个数字和每五个数字的结果？

** @Vityata

Public Sub PrintArrayOnSingleLine(myArray As Variant)

    Dim i As Long, x As Long
    Dim textArray As String, temp As String
    
    For i = LBound(myArray) To UBound(myArray)
        textArray = textArray & myArray(i)
        x = x + Val(myArray(i))
        temp = temp & "+" & myArray(i)
    Next i
    
    Dim myLastRow As Long
    myLastRow = LastRow(Worksheets(1).Name) + 1
    ActiveSheet.Cells(myLastRow, 1) = Mid(temp, 2) & "=" & x
    
End Sub

我已经按照你告诉我的方法编辑了程序，但只有一个注释，我无法得到相同的数字相加。示例：1+1=2

Answer 1

• 组合（不重复相同的值）：

复制下面的代码并运行它。然后更改size = n 中的变量。给定的数字在initialArray 中。最后，不要将数组打印为textArray，而是添加一个变量来求和：

Sub Main()
    
    Dim size As Long: size = 2
    Dim initialArray As Variant: initialArray = Array(1, 2, 3, 4, 5, 6)
    Dim arr As Variant: ReDim arr(size - 1)
    Dim n As Long: n = UBound(arr) + 1
    
    EmbeddedLoops 0, size, initialArray, n, arr
    
End Sub

Function EmbeddedLoops(index As Long, size As Long, initialArray As Variant, n As Long, arr As Variant)
    
    Dim p As Variant
    
    If index >= size Then
        If Not AnyValueBiggerThanNext(arr) And Not AnyValueIsRepeated(arr) Then
            PrintArrayOnSingleLine arr
        End If
    Else
        For Each p In initialArray
            arr(index) = p
            EmbeddedLoops index + 1, size, initialArray, n, arr
        Next p
    End If
    
End Function

Public Function AnyValueBiggerThanNext(arr As Variant) As Boolean

    Dim i As Long
    For i = LBound(arr) To UBound(arr) - 1
        If arr(i) > arr(i + 1) Then
            AnyValueBiggerThanNext = True
            Exit Function
        End If
    Next i
    
    AnyValueBiggerThanNext = False

End Function

Public Function AnyValueIsRepeated(arr As Variant) As Boolean
            
    On Error GoTo AnyValueIsRepeated_Error:
    
    Dim element As Variant
    Dim testCollection As New Collection
    
    For Each element In arr
        testCollection.Add "item", CStr(element)
    Next element
    
    AnyValueIsRepeated = False
    
    On Error GoTo 0
    Exit Function
    
AnyValueIsRepeated_Error:
    AnyValueIsRepeated = True
    
End Function

Public Sub PrintArrayOnSingleLine(myArray As Variant)

    Dim i As Long
    Dim textArray As String
    
    For i = LBound(myArray) To UBound(myArray)
        textArray = textArray & myArray(i)
    Next i
    
    Debug.Print textArray
    
End Sub

---

• 排列（重复相同的值）

---

Sub Main()
    
    Static size         As Long
    Static c            As Variant
    Static arr          As Variant
    Static n            As Long
    
    size = 3
    c = Array(1, 2, 3, 4, 5, 6)
    
    n = UBound(c) + 1
    ReDim arr(size - 1)
    
    EmbeddedLoops 0, size, c, n, arr
    
End Sub

Function EmbeddedLoops(index, k, c, n, arr)
    
    Dim i                   As Variant
    
    If index >= k Then
        PrintArrayOnSingleLine arr
    Else
        For Each i In c
            arr(index) = i
            EmbeddedLoops index + 1, k, c, n, arr
        Next i
    End If

End Function

Public Sub PrintArrayOnSingleLine(myArray As Variant)

    Dim counter     As Integer
    Dim textArray     As String
    
    For counter = LBound(myArray) To UBound(myArray)
        textArray = textArray & myArray(counter)
    Next counter
    
    Debug.Print textArray
    
End Sub

来源（免责声明 - from my blog）：

• VBA Nested Loop with Recursion
• VBA All Combinations