[已解决]按要求进行组合求和

chenyao4693365

给出一列，例如1到35，要求能自动从中选出五个数进行组合求合，将所有组合均显示出来

附样表，A列是给出来的原始数据，现在要求从A列中任选五个数值，不允许重复，五个数的和等于要求的数值。例如和为99，求代码，能使用VBA最好。
同时附一组合求和的代码，和我要求的显示功能是一样的，但是其中不是显示的数据太多，不知道怎么修改成我需要的那种方式。（注我现在要求的是，必须任选五个不重复的数据，这五个数的和等于要求的数值。）

最佳答案

月排行榜 / 总排行榜

qh8600

2014-10-21 15:12

按要求进行组合求和.rar (10.72 KB, 下载次数: 56)

2014-10-21 15:11 上传

点击文件名下载附件
。。。。。。

跳转到最佳答案楼层

su45

关注下…………

1091126096

用规划求解。

这儿有肥猫

如果用逗号分隔，可以考虑取巧一下~~不过治标不治本，给你个参考吧

qh8600

1. Dim arr(1 To 5), brr(), re, k As Long, aa As String, n, a, b
   
2. Sub demo()
   
3.     tms = Timer
   
4.     a = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
   
5.     b = Val(InputBox("请输入和是多少？(如10)"))
   
6.     re = Range("a1:a35")
   
7.     ReDim brr(1 To WorksheetFunction.Combin(a, 5), 1 To 1)
   
8.     k = 1
   
9.     Call dg(0, 1)
   
10.     MsgBox Format(Timer - tms, "0.000s ")
    
11.     Range("c1").Resize(k, 1) = brr
    
12. End Sub
    
13. Sub dg(i As Long, t As Long)
    
14.     Dim j As Long, m As Long
    
15.     For j = i + 1 To a - 5 + t
    
16.         arr(t) = re(j, 1)
    
17.         n = n + arr(t)
    
18.         aa = Join(arr, ",")
    
19.         If t = 5 Then
    
20.             If n = b Then
    
21.                 brr(k, 1) = aa
    
22.                 k = k + 1
    
23.             End If
    
24.         Else
    
25.             Call dg(j, t + 1)
    
26.         End If
    
27.         n = n - arr(t)
    
28.     Next
    
29. End Sub
    

复制代码

楼主试试

qh8600

按要求进行组合求和.rar (10.72 KB, 下载次数: 56)

2014-10-21 15:11 上传

点击文件名下载附件
。。。。。。

xdragon

1. Sub test()
   
2.     Dim conn As Object, n%, sql$, selectstr$(), fromstr$(), wherestr$(), GetSumNum$
   
3.     Columns(3).ClearContents
   
4.     GetSumNum = Val(InputBox("请输入和是多少？(如10)"))
   
5.     Set conn = CreateObject("Adodb.Connection")
   
6.     conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";"
   
7.     n = 5
   
8.     ReDim selectstr(1 To n), fromstr(1 To n), wherestr(1 To n - 1)
   
9.     For i = 1 To n
   
10.        selectstr(i) = "a" & i & ".F1"
    
11.        fromstr(i) = "[" & ActiveSheet.Name & "$A:A]a" & i
    
12.        If i < n Then wherestr(i) = "a" & (i - 1) Mod n + 1 & ".F1<a" & i Mod n + 1 & ".F1"
    
13.     Next
    
14.     sql = "SELECT DISTINCT " & Join(selectstr, "&','&") & " FROM " & Join(fromstr, ",") & " WHERE " & Join(wherestr, " and ") & " and " & Join(selectstr, "+") & "=" & GetSumNum
    
15.     Range("C1").CopyFromRecordset conn.Execute(sql)
    
16.     conn.Close
    
17.     Set conn = Nothing
    
18. End Sub

复制代码

上清宫主

群子发过个，非常高效、实用，你去找找看