2017-02-24 52 views
1

我需要找出一種方法來輸出結果的所有組合的行數(最好,如果可能在一個單一行)Excel vba如何將數字輸出組合到Excel行?

我有8位數{1,2,3,4,5, 6,7,8}組合的典型輸出是i; j(i,j是來自集合的數字,如果選擇兩個,則爲i < 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的例子,我已經將它輸出到工作表的行。

我也有解決方案,拿起3,現在我的問題是其餘的情況下,如何得到輸出?

下面是用於拾取3溶液:

Dim Myarray_3 As String 
     Myarray_3 = ""   ' 3 out of 8 
    k = 3 
    Do While k >= 3 And k <= 8 
    'inner loop through i j 
     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(ⅰ)被初始化爲MYARRAY(i)所述的方式= I

+0

是'1,2'和'2,1'是一回事嗎?如果是這樣,嵌套循環會做到這一點。 – Jeeped

+0

+0

我會一直說的第一件事就是在數組中做你的組合工作。然後在最後輸出數組.. – MacroMarc

回答

0

我發現一些代碼,我從另一個有好的程序員,我改變了代碼以適應你的問題。如果您將N設爲您的set/array的成員數量,那麼您將擁有(2^N)-1組合,但是您可以使用自己的條件對其進行過濾。請注意,在您的問題中,使用您的條件進行過濾時,成員的順序將非常重要。

該代碼將首先生成所有組合,然後應用條件。數組結果將是主輸出,因此它的大小將始終爲(2^N)-1。陣列結果 - 過濾將是你想要的。

請注意,如果您有從左到右排序的數字,數組Result和Result_filtered將是相同的。

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

該方法使用按位計算,以獲得組合:

如果N = 2,則數comnibations的將是(2^2)-1 = 3 我們總是排除0」當然 {的二進制A,B} - > {[00],[01],[10],[11]} - > {ignore,[B],[A],[AB]}

我希望這有助於!如果沒有,請打對勾這個前面回答

運行子測試:

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 
    '(e.g. 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