Select n numbers from 1 to m with all of array 'all' and none of array 'none'

本文介绍了一种使用VBA实现的从1到m中选择n个数的算法,该算法确保了所有指定数组中的元素都会被选中,而另一个指定数组中的元素则不会被选中。通过递归回溯的方法,可以找出所有可能的组合。

How to select n numbers from 1 to m with all of array 'all' and none of array 'none'? Try the following codes,please.

 

Sub getall(ByVal m As Long, ByVal n As Long, ByRef all, ByRef none) 'Select n numbers from 1 to m with all of array 'all' and none of array 'none' Dim Results() As Long, i As Integer, m1 As Long, n1 As Long, k As Integer, num As Long, a() As Long, b() As Long, c() As Long [a1].CurrentRegion = "" ReDim b(1 To m) For i = 0 To UBound(all) 'All items of this array must be selected b(all(i)) = 1 Next For i = 0 To UBound(none) 'No items of this array can be selected b(none(i)) = 2 Next For i = 1 To m 'Numbers from 1 to m without x & y If b(i) = 0 Then m1 = m1 + 1 ReDim Preserve Results(1 To m1) Results(m1) = i End If Next n1 = n - UBound(all) - 1 'Count of numbers to select except array 'all' ReDim a(1 To n1) 'Backtracking method to select n1 items from m1 numbers,more details,see:http://en.wikipedia.org/wiki/Backtracking k = 1 Do a(k) = a(k) + 1 If a(k) > m1 Then k = k - 1 Else For i = 1 To k - 1 If a(k) = a(i) Then Exit For Next If i = k Then If k = n1 Then num = num + 1 ReDim Preserve c(1 To m, 1 To num) For j = 1 To n1 c(Results(a(j)), num) = 1 Next End If If k < n1 Then k = k + 1 a(k) = a(k - 1) End If End If End If Loop Until k = 0 ReDim Results(1 To num, 1 To n) For i = 1 To num k = 0 For j = 1 To m If c(j, i) = 1 Or b(j) = 1 Then 'Number j was selected by previous Backtracking method or in array 'all' at first. k = k + 1 Results(i, k) = j End If Next j, i [a1].Resize(num, n) = Results 'Output to excel worksheet MsgBox num & " solutions were found when selecting " & n & " numbers from 1 to " & m & " with all of array {" & Join(all, ",") & "} and none of array {" & Join(none, ",") & "}" End Sub Sub Main() getall 15, 8, Array(1, 7, 10), Array(2, 3, 4, 5, 8) End Sub

 

It returns:

 

 

 

转载于:https://www.cnblogs.com/fengju/archive/2009/12/15/6336200.html

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值