排列组合问题-小周专栏

1.本例是利用位运算，把所有的结果列出来，然后根据元素是否出现得到结果，这个虽然不是最高效的，但是这个代码简单；
2.本列计算20个元素约需14秒，每多一个用时增加一倍，少一个减少一半；
3.实际应用于数据统计，比如财务回款。如银行回款1000元，又没有标发票号码（实际应用中经常这样），但是可能是几张发票的组合，这时候财务人员就很头疼了，不知道到底是那几张单子该注销，此时就可以用到本方法；
4.原来用剪枝法、迭代法写了两天都没有搞定，网上也没有找到更好的办法，就本问题如果哪位朋友有更好的办法，欢迎分享，谢谢！
5.为了测试方便，根据元素个数，自动生产一个连续数组，如：输入5，生成一个1，2，3，4，5的数组进行运算，实际应用中可用记录集给数组赋值。

代码如下：
Dim a() As Integer    '数组
Dim i, j, k As Integer  '循环变量
Dim total As Integer '元素总数
Dim result As Integer '结果值
Dim result0 As Integer  '中间值，循环时与结果值比较
Dim temp As Integer    '判断位置上是否有对应元素
Dim str As String    '中间结果
Dim display As String '最终结果
Dim c As Integer       '计数器
Dim t As Date          '记录开始时间
t = Now()
total = txtTotal
result = txtResult
c = 0
'给数组赋值
ReDim a(total)
For i = 1 To total
a(i) = i
Next
'----------
For j = 1 To 2 ^ total
result0 = 0
str = ""
For k = 1 To total
      'temp = IIf((j And (2 ^ (k - 1))) = 0, 0, a(k))    '实践证明，用iif没有if then 快
      If (j And (2 ^ (k - 1))) = 0 Then: temp = a(k): Else: temp = 0
      If temp <> 0 Then str = str & "+" & temp
      result0 = result0 + temp
Next
If result0 = result Then
      display = display & result & " = " & Right(str, Len(str) - 1) & vbCrLf
      c = c + 1
End If
Next
Me.Text3.Value = "共找到" & c & "个满足条件的组合，用时" & DateDiff("s", t, Now()) & "秒。结果如下：" & vbCrLf & vbCrLf & _
               "--------------" & vbCrLf & _
               display & _
               "=============="

点击下载此附件