Excel vba在同一行中创建每个组合

我需要一个宏的帮助，它可以导出同一行中某个范围的所有组合，每个组合都是水平导出

每次我都想待在一个牢房里

我想随时更改范围内的字符串数量，以及下面示例中的字符串组合数量范围内的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

---

以下是一种方法：

在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等列，以便获得所有结果。{和}不能手动插入，它们是数组公式的标记：

将单元格E2、F2、G2、H2等选择到Z2 键入公式 要验证输入，请按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_组合是递归调用的。此方法的性能非常差，因为它使用字符串数组并进行大量重新分配。如果考虑更大的数据集，就必须优化它。 欢迎光临。您尝试了什么？谢谢Arno，我尝试了在web中找到的模块。作为Vba中的新模块，我无法进行自己的更改。您能将示例数据格式化为更易于理解的格式吗？ABCD全部在一个单元格中吗？它们之间有空格吗？谢谢你的回复。在我的初始范围内，每个字符串都在一个单元格中。不是ABCD全部在一个单元格中。因此，它们不会用空格分隔。但是每个组合id都希望在一个单元格中。例如ABC所有这些都在一个单元格中，ABD所有这些都在行的下一个单元格中。您好，d-stroyer。非常感谢您的回答。我只是尝试了一下，但出现了一个问题。在导出此函数时，没有字母队列。示例：对于4组字母ABCD，3的一个组合是ACD。您的函数给了我一个我不想要的CDA。有什么方法可以修复它吗？同样，当我选择时，对于4组字母ABCD，2个字母的组合，我更改为{=k_组合ConcatenateA2；B2；C2；D2；2}这只给了我四个梳子，重复相同的，应该是六种不同的组合。再次感谢您友好的回答。这不是代码问题。您在E2中输入了一个公式，然后将其扩展到F2。。。这意味着F2中的公式与E2中的公式不同。正如我在文章中所说，你必须把它写成一个数组公式！当然，这不是代码问题。问题是我的，因为我没有看到你的3个帮助步骤。这现在真的很有效。非常感谢，伙计。很高兴它有效。事实上，我在你最后的评论之后添加了3个帮助。此excel功能不是最方便用户使用的。顺便说一下，如果你喜欢我的答案，请接受。