Excel vba在同一行中創建組合每個

Question

我需要一個宏，它可以導出同一行中的每個範圍的所有組合（每個都是水平導出）。

我希望每次都在一個單元格中的每個組合。

我想改變的任何時間在範圍串的數量，並且還串組合的數目（在下面的例子中的範圍爲4串和3的組合）

1. A B C D  -------------ABC --ABD--ACD--BCD 
2. E F G H--------------EFG---EFH--EGH--FGH 
3. I G K L----------------IGK----IGL---IKL---GKL 

低於其的模塊我在網上發現的東西非常接近我需要的東西。

我很新的VBA宏，我無法實現我所尋找與下面的代碼

Private NextRow As Long 

Sub Test() 
Dim V() As Variant, SetSize As Integer, i As Integer 

    SetSize = Cells(2, Columns.count).End(xlToLeft).Column 
    ReDim V(1 To SetSize) 

    For i = 1 To SetSize 
     V(i) = Cells(2, i).Value 
    Next i 

    NextRow = 4 
    CreateCombinations V, 3, 3 

End Sub 


Sub CreateCombinations(_ 
        OriginalSet() As Variant, _ 
        MinSubset As Integer, MaxSubset As Integer) 

Dim SubSet() As Variant, SubSetIndex As Long 
Dim SubSetCount As Integer, Bit As Integer 
Dim k As Integer, hBit As Integer 
Dim MaxIndex As Long 

hBit = UBound(OriginalSet) - 1 
ReDim SubSet(1 To UBound(OriginalSet)) 

    MaxIndex = 2^UBound(OriginalSet) - 1 
    For SubSetIndex = 1 To MaxIndex 
     SubSetCount = BitCount(SubSetIndex) 
     If SubSetCount >= MinSubset And SubSetCount <= MaxSubset Then 
      k = 1 
      For Bit = 0 To hBit 
       If 2^Bit And SubSetIndex Then 
        SubSet(k) = OriginalSet(Bit + 1) 
        k = k + 1 
       End If 
      Next Bit 
      DoSomethingWith SubSet, SubSetCount 
     End If 
    Next SubSetIndex 
End Sub 


Sub DoSomethingWith(SubSet() As Variant, ItemCount As Integer) 
Dim i As Integer 


    For i = 1 To ItemCount 
     Cells(NextRow, i) = SubSet(i) 
    Next i 
    NextRow = NextRow + 1 
End Sub 





Function BitCount(ByVal Pattern As Long) As Integer 
    BitCount = 0 
    While Pattern 
     If Pattern And 1 Then BitCount = BitCount + 1 
     Pattern = Int(Pattern/2) 
    Wend 
End Function 

Answer 1

下面是一個辦法做到這一點：

在您的Excel工作表，添加陣列公式如下：

 A  B  C  D E 
1 
2 A  B  C  D {=k_combinations(CONCATENATE(A2;B2;C2;D2);3)} 
3 E  F  G  H {=k_combinations(CONCATENATE(A3;B3;C3;D3);3)} 

請注意，您應該將數組公式列擴展到列F，G，H等，以便獲得所有結果。 （該{和}不應被手動插入，它們是陣列式的標記）：

1. 選擇單元格E2，F2，G2，H2，等等到Z2
2. 鍵入式
3. 爲了驗證輸入，按下Ctrl + Shift + Enter鍵

將以下代碼到代碼模塊。

Public Function k_combinations(ByVal chLetters As String, ByVal k As Long) As Variant 
Dim chCombinations() As String 
Dim uCount As Long 
Dim vReturn() As Variant 
Dim i As Long 

uCount = Get_k_combinations(chLetters, chCombinations, k) 

ReDim vReturn(0 To uCount - 1) As Variant 

For i = 0 To uCount - 1 
    vReturn(i) = chCombinations(i) 
Next i 

k_combinations = vReturn 

End Function 

Private Function Get_k_combinations(chLetters As String, chCombinations() As String, ByVal k As Long) As Long 

Dim i As Long 
Dim M As Long 
M = Len(chLetters) 

If k > 1 Then 

    Get_k_combinations = 0 
    For i = 1 To M - (k - 1) 
    Dim chLetter As String 
    Dim uNewCombinations As Long 
    Dim chSubCombinations() As String 
    Dim j As Long 
    chLetter = Mid$(chLetters, i, 1) 
    uNewCombinations = Get_k_combinations(Right$(chLetters, M - i), chSubCombinations, k - 1) 
    ReDim Preserve chCombinations(0 To Get_k_combinations + uNewCombinations) As String 
    For j = 0 To uNewCombinations - 1 
    chCombinations(Get_k_combinations + j) = chLetter & chSubCombinations(j) 
    Next j 
    Get_k_combinations = Get_k_combinations + uNewCombinations 
    Next i 

Else 

    ReDim chCombinations(0 To M - 1) As String 
    For i = 1 To M 
    chCombinations(i - 1) = Mid$(chLetters, i, 1) 
    Next i 
    Get_k_combinations = M 

End If 

End Function 

Get_k_combinations被遞歸調用。這種方法的性能很差（因爲它使用字符串數組並進行大量重新分配）。如果你考慮更大的數據集，你將不得不優化它。