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:
