如何使用Excel VBA列出满足特定条件的所有组合？
从1到8888，每个数字的总和等于或小于8的组合是什么 例如，如何使用Excel VBA列出满足特定条件的所有组合？,vba,excel,mathematical-optimization,operations,Vba,Excel,Mathematical Optimization,Operations,从1到8888，每个数字的总和等于或小于8的组合是什么 例如， 70000001=7+0+0+0+0+0+0+0+0+1=8应该在列表中 00000021=0+0+0+0+0+0+0+2+1=3应该在列表中。 20005002=2+0+0+0+5+0+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
70000001=7+0+0+0+0+0+0+0+0+1=8应该在列表中
00000021=0+0+0+0+0+0+0+2+1=3应该在列表中。
20005002=2+0+0+0+5+0+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
。。。这就是你要找的吗
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（）希望这能有所帮助你建议的方法非常残忍。在我的机器上，它运行了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 私有常量cIntNumberOfDigits为整数=9 私有mStrNum作为字符串 私人mRng As范围 专用子编号（） Dim dblStart为双精度 设置mRng=范围（“a1”） dblStart=计时器 mStrNum=Replace（空格（cIntNumberOfDigits），“”，“0”） 子组编号8 Debug.Print（Timer-dblStart）/10000000（Timer-dblStart） 端接头 私有子subGetNumbers（intMaxSum为整数，可选intStartPos为整数=1） 作为整数的Dim i 如果intStartPos=cIntNumberOfDigits，则 Mid（mStrNum，intStartPos，1）=intMaxSum mRng.Value=Val（mStrNum） 设置mRng=mRng.偏移量（1） Mid（mStrNum，intStartPos，1）=0 出口接头 如果结束 对于i=0到intMaxSum Mid（mStrNum，intStartPos，1）=CStr（一） 子getnumbers intMaxSum-i，intStartPos+1 接下来我 Mid（mStrNum，intStartPos，1）=0 端接头
通过使用数组而不是直接写入范围并对其进行偏移，可以将速度进一步提高约10倍，但这就足够了！：-）作为替代方法，您可以使用如下函数：
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
现在将
如果i=8如果isInnerLowr8（i），则EVALUATE