如何使用Excel VBA列出满足特定条件的所有组合?

时间:2013-02-11 15:26:14

标签: excel vba excel-vba mathematical-optimization operations

每个数字的总和等于8或更小,从1到88,888,888的组合是什么?

例如,
70000001 = 7 + 0 + 0 + 0 + 0 + 0 + 0 + 1 = 8 应该在列表中 00000021 = 0 + 0 + 0 + 0 + 0 + 0 + 2 + 1 = 3 应该在列表中。
20005002 = 2 + 0 + 0 + 0 + 5 + 0 + 0 + 2 = 9 不应在列表中。

Sub Comb()
Dim r As Integer 'Row (to store the number)
Dim i As Integer 'Range
r = 1
For i = 0 To 88888888
If i = 8
'How can I get the sum of the digits on vba?
ActiveSheet.Cells(r, 1) = i
r = r + 1
End If
Else
End Sub

3 个答案:

答案 0 :(得分:1)

......这就是你要找的东西吗?

Function AddDigits(sNum As String) As Integer

Dim i As Integer

   AddDigits = 0
   For i = 1 To Len(sNum)
      AddDigits = AddDigits + CInt(Mid(sNum, i, 1))
   Next i

End Function

(请记住在传递给函数的数字上使用CStr()

如果没有,你能否更详细地解释一下你想要的东西。

希望这有帮助

答案 1 :(得分:0)

你建议的方法几乎是蛮力。在我的机器上,运行6.5分钟来计算所有数字。到目前为止,我试图找到一种更有效的算法。

这个需要大约0.5秒:

Private Const cIntNumberOfDigits As Integer = 9
Private mStrNum As String
Private mRng As Range

Private Sub GetNumbers()
    Dim dblStart As Double
    Set mRng = Range("a1")
    dblStart = Timer
    mStrNum = Replace(Space(cIntNumberOfDigits), " ", "0")
    subGetNumbers 8
    Debug.Print (Timer - dblStart) / 10000000, (Timer - dblStart)
End Sub


Private Sub subGetNumbers(intMaxSum As Integer, Optional intStartPos As Integer = 1)
    Dim i As Integer

    If intStartPos = cIntNumberOfDigits Then
        Mid(mStrNum, intStartPos, 1) = intMaxSum
        mRng.Value = Val(mStrNum)
        Set mRng = mRng.Offset(1)
        Mid(mStrNum, intStartPos, 1) = 0
        Exit Sub
    End If

    For i = 0 To intMaxSum
        Mid(mStrNum, intStartPos, 1) = CStr(i)
        subGetNumbers intMaxSum - i, intStartPos + 1
    Next i
    Mid(mStrNum, intStartPos, 1) = 0
End Sub

通过使用数组而不是直接写入范围并抵消它,它可以进一步加速大约10倍,但这应该足够了! : - )

答案 2 :(得分:0)

作为替代方案,您可以使用如下函数:

Function isInnerLowr8(x As Long) As Boolean
    Dim strX As String, inSum As Long

    isInnerLowr8 = False
    strX = Replace(CStr(x), "0", "")
    For i = 1 To Len(strX)
        Sum = Sum + Val(Mid(strX, i, 1))
        If Sum > 8 Then Exit Function
    Next i
    isInnerLowr8 = True
End Function

现在将If i = 8更改为If isInnerLowr8(i) Then