Question

VB一个算法问题。

现有一系列无规律的数字，例如：3，7，4，5，4，8，20，……，由这些数字的一部分或全部加起来，可能的和，没有哪些数字？比如现在的例子中，和就不会有1，2，6，17等。数字系列是不确定的，求算法或代码。

Answer 1

//就像你上面的数据3，7，4，5，4，8，20.用下面的代码得到的结果是(不包含)
1、2、6、9、12、13、16、17、21、24、25、26、28、29、32、33、35、36、37、38、40、41、42、44、45、46、47、48、49、50、51、
//原理就是塞选法.这个算法是很笨的。其实你可以先考虑排下序试试

Private IsExit(0) As Boolean
Private n, SumTemp As Integer 'n表示第几层
Private Data(0) As Integer
Private Sub MainRun(ByVal s() As Integer)
Dim ret As String = ""
Dim i As Integer
Data = s
n = Data.Length - 1
For i = 0 To n
SumTemp += Data(i)
Next
ReDim IsExit(SumTemp)
SumTemp = 0
While n > 0
CallRun(0, n)
n -= 1
End While

For i = 1 To IsExit.Length - 1
If IsExit(i) = False Then
ret += i.ToString + "、"
End If
Next
MessageBox.Show(ret)
End Sub
Private Sub CallRun(ByVal Index As Integer, ByVal n2 As Integer)
Dim i, temp As Integer
If n2 = 1 Then
For i = Index To Data.Length - 1
IsExit(SumTemp + Data(i)) = True
Next
SumTemp = 0
Else
temp = SumTemp
n2 -= 1
For i = Index To Data.Length - n2 - 1
SumTemp = temp + Data(Index)
CallRun(Index + 1, n2)
Next
End If
End Sub
Private Sub Test()//测试函数
Dim s() As Integer = {3, 7, 4, 5, 4, 8, 20}
MainRun(s)
End Sub

追问

4+5=9 ，5+7=12，4+8=12，5+8=13，4+5+7=16， 能否帮忙完善一下。

追答

Private IsExit(0) As Boolean
Private n, SumTemp As Integer 'n表示第几层
Private Data(0) As Integer
Private Sall As String
Private Function MainRun(ByVal s() As Integer) As String
Sall = ""
Dim ret As String = ""
Dim i As Integer
Data = s
n = Data.Length - 1
For i = 0 To n
SumTemp += Data(i)
Next
ReDim IsExit(SumTemp)
SumTemp = 0
While n > 0
CallRun(0, 0, n, "0")
n -= 1
End While

For i = 1 To IsExit.Length - 1
If IsExit(i) = False Then
ret += i.ToString + "、"
End If
Next
Return ret
End Function

Private Sub CallRun(ByVal Sum As Integer, ByVal Index As Integer, ByVal n2 As Integer, ByVal s As String)
Dim i, temp As Integer
If n2 = 1 Then
For i = Index To Data.Length - 1
temp = Sum + Data(i)
Sall += s + "+" + Data(i).ToString + "=" + temp.ToString + vbCrLf
IsExit(temp) = True
Next
Else
Dim j As Integer = n2 - 1
Dim s2 As String
For i = Index To Data.Length - n2 + 1
temp = Sum + Data(i)
s2 = s + "+" + Data(i).ToString
CallRun(temp, i + 1, j, s2)
Next
End If
End Sub
Private Sub Test()
Dim s() As Integer = {3, 7, 4, 5, 4, 8, 20}
Dim ret As String = "可排除的数据:" + MainRun(s) + vbCrLf + "可能的组合如下:" + vbCrLf + Sall
My.Computer.FileSystem.WriteAllText("C:\123.txt", ret, False)
End Sub
执行上面的Test函数会生成C:\123.txt文件，那里你可以得到很完整的答案，如下
可排除的数据:1、2、6、45、49、50、51、
可能的组合如下:
0+3+7+4+5+4+8=31
0+3+7+4+5+4+20=43
0+3+7+4+5+8+20=47
0+3+7+4+4+8+20=46
0+3+7+5+4+8+20=47
0+3+4+5+4+8+20=44
0+7+4+5+4+8+20=48
0+3+7+4+5+4=23
0+3+7+4+5+8=27
0+3+7+4+5+20=39
……字数受限

追问

我没有.net ，只VB6 ,没法试。但你说可排除的数据:1、2、6、45、49、50、51里边，所有的数加起来是51。

追答

1、
看到上面
ReDim IsExit(SumTemp)
代码之后添加
IsExit(SumTemp)=True即可，这个是我忘记了
2、
如果你没有.NET，把
My.Computer.FileSystem.WriteAllText("C:\123.txt", ret, False)
这句话改成
MsgBox （ret）
即可.自己测试下吧

Answer 2

楼主到现在还没结贴证明还没找到所求，正好有空，我就补上VB6的码：
问题考点：数字组合算法，就用最简单的递归吧。
你先建三text,text1的属性：scrollbars设为2 multiline设定true, text1纵轴拉长点，text2、text3左右拉长点点（好看数)，以及一command1
Option Explicit
Dim sourceArray, dstArray, strSum As String, isExist() As Integer
Private Sub Combine(a, n As Integer, m As Integer, b, mm As Integer) '递归算法
Dim i%, j%, strSum$, sum%
For i = n To m Step -1
b(m - 1) = i - 1
If m > 1 Then
Call Combine(a, i - 1, m - 1, b, mm)
Else
sum = 0
strSum = ""
For j = mm - 1 To 0 Step -1
sum = sum + a(b(j))
strSum = strSum & a(b(j)) & "+"
Next j
isExist(sum) = 1
strSum = Left$(strSum, Len(strSum) - 1) & "=" & sum
Text1 = Text1 & strSum & vbCrLf
DoEvents
End If
Next i

End Sub
Private Sub Command1_Click()
Dim nCount As Integer, ArrayMax As integer, ArrayMin As integer, strTemp As String, intTemp As integer
Dim i As Integer, sum As Integer
nCount = InputBox("请输入该系列数字的总数：")
ArrayMin = InputBox("请输入该系列数字的最小值：")
Do While ArrayMax <= ArrayMin
If ArrayMax <> 0 Then
ArrayMax = InputBox("最大值必须比最小值" & ArrayMin & "大，请输入该系列数字的最大值：")
Else
ArrayMax = InputBox("请输入该系列数字的最大值：")
End If
Loop
Randomize
Text1 = ""
Text2 = "该系列数字具体为："
For i = 1 To nCount
intTemp = Int(Rnd * (ArrayMax - ArrayMin + 1) + ArrayMin) '随机产生数字
Text2 = Text2 & intTemp & " "
strTemp = strTemp & intTemp & " "
Next
sourceArray = Split(RTrim$(strTemp))
dstArray = Split(RTrim$(strTemp))
For i = 0 To nCount - 1
sum = sum + sourceArray(i)
Next i
ReDim isExist(sum) As Integer
Text3 = "计算中，请稍等......"
For i = 1 To nCount
Call Combine(sourceArray, nCount, i, dstArray, i)
Next
Text3 = "可能的和一定没下列数字："
For i = 0 To sum
If isExist(i) = 0 Then
Text3 = Text3 & i & " "
End If
Next
Text3 = Text3 & "以及大于" & sum & "的所有数" '最终结果
End Sub

追问

谢谢你。我用你的代码试了。数字只有几个的时候还行，但数字多了，就不知什么时候才运算结束。有更好一些的算法吗？

追答

老兄，你还没结贴啊，你这问题要求的是所有组合方式中的数字相加啊（你这种不定型的没规律可找），能快吗？如有10个数，就是C[10][1]+c[10][2]+...+c[10][10],总数约是一7位数，11个约8位，12个数9位，13个数10位，长整型变量已经溢出，当数是20个数，已到18位数，3亿亿种组合，在3亿亿种组合还要将数字相加，你想想你的CPU是多少？才G级啊，何为G级？也就是每秒才10的9次方10亿运算能力，当数字到达一定数量时，肯定就不知什么时候才运算结束：）
当然，别人的是3.0G CPU 你的CPU是3.0GG的话那当我没说过，噢，天下，那样Intel里的人个个都要围着你求技术了。

不过上面代码也确实可以优化，将一些同结果无关的东西去掉就行，如你单要最终结果可试试下面：定义多一个和数组sumarray()
Dim sumArray() As Integer
Private Sub Combine(a, n As Integer, m As Integer, b, mm As Integer)
Dim i%, j%, strSum$
For i = n To m Step -1
b(m - 1) = i - 1
sumArray(m - 1) = sumArray(m) + a(i - 1) ‘将和存起来，避免重复计算
If m > 1 Then
Call Combine(a, i - 1, m - 1, b, mm)
Else
isExist(sumArray(0)) = 1 ‘将每个组合的最终和存储在这
End If
Next i
另在循环计算处重定义sumArray()
For i = 1 To nCount
ReDim sumArray(nCount)
Call Combine(sourceArray, nCount, i, dstArray, i)
Next
开贴不结，不厚德哦。

Answer 3

做一个不定长的数组
输入数据到数组
从0到全部数的和循环
从数组第一个到最后一个循环对比
如果不是 则显示此数

追问

希望详细说一下。

Answer 4

表达得不够清楚 还不是没有理解你的意图