範囲のすべての組み合わせをそれぞれ同じ行にエクスポートするマクロの助けが必要です (水平エクスポートを意味します)。
毎回1つのセルになりたいすべての組み合わせ。
範囲内の文字列の数と文字列の組み合わせの数をいつでも変更したい (下の例では、範囲内の 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
その下には、必要なものに非常に近いWebで見つけたモジュールがあります。
私は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