Excel 获取求和数的所有组合_Excel_Vba

Excel 获取求和数的所有组合

excel vba

Excel 获取求和数的所有组合,excel,vba,Excel,Vba,sheet1中的A列的值[1,2,3,4,5,6]在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

sheet1中的A列的值[1,2,3,4,5,6]在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

每两个数字都可以。。我如何获得每三个数字、每四个数字和每五个数字的结果

**@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

不重复相同值的组合：复制下面的代码并运行它。然后在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()
    
    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

重复相同值的置换来源免责声明-：

结果显示在即时窗口CTRL+G中，从textArray显示。尝试循环遍历数组的元素，每次都将它们写入一个新的单元格。你必须将它放在数字书架上的某个地方=@YasserKhalil-这个应该在活动表中打印文本数组-这对我来说是新的，Vitoshacademy是你的博客。我非常喜欢你在博客上发布的内容。不客气，很好。。。投票赞成。但它返回N乘以k的正常组合。在他的示例中，OP看起来也需要1+1、2+2、3+3等。了解代码来自您的优秀收藏。。。无论如何，修改代码并不十分复杂。普通最大组合的算法必须是这样的！结果显示在即时窗口CTRL+G中，从textArray显示。尝试循环遍历数组的元素，每次都将它们写入一个新的单元格。你必须将它放在数字书架上的某个地方=@YasserKhalil-这个应该在活动表中打印文本数组-这对我来说是新的，Vitoshacademy是你的博客。我非常喜欢你在博客上发布的内容。不客气，很好。。。投票赞成。但它返回N乘以k的正常组合。在他的示例中，OP看起来也需要1+1、2+2、3+3等。了解代码来自您的优秀收藏。。。无论如何，修改代码并不十分复杂。普通最大组合的算法必须是这样的！

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