Excel VBA如何获得数字输出到Excel行的组合？

我需要find一种方法来输出数字的所有组合的结果（最好，如果可能在一行）

我有8个数字{1,2,3,4,5,6,7,8}组合的典型输出是i; j（i，j是来自集合的数字，而我是<j）。 生成结果很简单：

Dim Myarray_2 As String Dim sht as Worksheet set sht = Sheet1 Myarray_2 = "" ' pick up 2 out of 8 For j = 2 To 8 For i = 1 To j - 1 sht.Cells(i + 1, j + 1) = Str(MyArray(i)) + ";" + Str(MyArray(j)) Myarray_2 = Myarray_2 + Str(MyArray(i)) + ";" + Str(MyArray(j)) + "|" Next i Next j 

这是拿起2的例子，我已经把它输出到工作表的行。

我也有解决scheme，拿起3，现在我的问题是其余的情况下，如何取出？

这是拿起3的解决scheme：

  Dim Myarray_3 As String Myarray_3 = "" ' 3 out of 8 k = 3 Do While k >= 3 And k <= 8 'inner loop through ij For j = 2 To k - 1 For i = 1 To j - 1 sht.Cells(i + 11, j - 1 + m) = Str(MyArray(i)) + ";" + Str(MyArray(j)) + ";" + Str(MyArray(k)) Myarray_3 = Myarray_3 + Str(MyArray(i)) + ";" + Str(MyArray(j)) + ";" + Str(MyArray(k)) + "|" Next i Next j k = k + 1 m = m + 7 Loop 

顺便说一句MyArray（i）被初始化为Myarray（i）= i

Answer 1

我发现我从另一个好的程序员那里得到了一些代码，我改变了代码来适应你的问题。 如果你的组合/数组的成员数为N，那么你将有（2 ^ N）-1组合，但是你可以使用你自己的条件过滤它们。 请注意，在你的问题，成员的顺序将是重要的，当涉及到使用您的条件过滤。

代码将首先生成所有组合，然后应用条件。 数组结果将是主输出，所以它的大小总是（2 ^ N）-1。 数组结果 – 过滤将是你想要的。

请注意，如果您有从左到右sorting的数字，数组Result和Result_filtered将是相同的。

您可以将任何格式的输出打印到任何工作表中。

该方法使用按位计算来获得组合：

如果N = 2，那么联合的数量将是（2 ^ 2）-1 = 3，我们总是排除当然是{A，B} – > {[00]，[01]，[10]，[ 11]} – > {ignore，[B]，[A]，[AB]}

我希望这有帮助！ 如果是这样，请打上对勾

运行子testing：

 Sub Test() Dim bCondSatisfied As Boolean Dim InxComb As Integer Dim InxResult As Integer Dim count As Integer Dim i As Integer Dim j As Integer Dim arr() As String Dim TestData() As Variant Dim Result() As Variant Dim Result_filtered() As Variant TestData = Array(1, 3, 2, 4) Call GenerateCombinations(TestData, Result) 'Now you have all the possible combinations, you can apply custom conditions '(eg any number on the left side of another number should be smaller, practically this is satisfied with the ' given test array, but if the numbers are scrambled it will fix the problem) ReDim Result_filtered(0 To 0) Result_filtered(0) = "No Combination Matched the Condition" 'default for the case there is no result matched count = 0 For i = 0 To UBound(Result) arr() = Result(i) bCondSatisfied = True If UBound(arr) > 0 Then 'if there is more than one number in the array, compare the adjacent numbers For j = 0 To UBound(arr) - 1 If arr(j) > arr(j + 1) Then bCondSatisfied = False Exit For End If Next j End If 'Store the array in the filtered array if it passed the test If bCondSatisfied = True Then ReDim Preserve Result_filtered(count) Result_filtered(count) = arr count = count + 1 End If Next i 'Print Result For InxResult = 0 To UBound(Result) Debug.Print Right(" " & InxResult + 1, 3) & " "; For InxComb = 0 To UBound(Result(InxResult)) Debug.Print "[" & Result(InxResult)(InxComb) & "] "; Next Debug.Print Next Debug.Print "-----------------" 'separate two results 'Print Result_filtered For InxResult = 0 To UBound(Result_filtered) Debug.Print Right(" " & InxResult + 1, 3) & " "; For InxComb = 0 To UBound(Result_filtered(InxResult)) Debug.Print "[" & Result_filtered(InxResult)(InxComb) & "] "; Next Debug.Print Next End Sub Sub GenerateCombinations(ByRef AllFields() As Variant, _ ByRef Result() As Variant) Dim InxResultCrnt As Integer Dim InxField As Integer Dim InxResult As Integer Dim i As Integer Dim NumFields As Integer Dim Powers() As Integer Dim ResultCrnt() As String NumFields = UBound(AllFields) - LBound(AllFields) + 1 ReDim Result(0 To 2 ^ NumFields - 2) ' one entry per combination ReDim Powers(0 To NumFields - 1) ' one entry per field name ' Generate powers used for extracting bits from InxResult For InxField = 0 To NumFields - 1 Powers(InxField) = 2 ^ InxField Next For InxResult = 0 To 2 ^ NumFields - 2 ' Size ResultCrnt to the max number of fields per combination ' Build this loop's combination in ResultCrnt ReDim ResultCrnt(0 To NumFields - 1) InxResultCrnt = -1 For InxField = 0 To NumFields - 1 If ((InxResult + 1) And Powers(InxField)) <> 0 Then ' This field required in this combination InxResultCrnt = InxResultCrnt + 1 ResultCrnt(InxResultCrnt) = AllFields(InxField) End If Next ' Discard unused trailing entries ReDim Preserve ResultCrnt(0 To InxResultCrnt) ' Store this loop's combination in return array Result(InxResult) = ResultCrnt Next End Sub