VBA 組み合わせ表示

質問

（例）セルＢ2からＢ7にランダムな数字が6個入ってます。（たとえば5・15・29・39・48・68　など。数値はＢ2からＢ8の7個等にその都度増減します）この数値から4個を取り出し、その組み合わをすべてセルＫ1から下に列挙したいのですが！

できれば初心者用にわかりやすコードでお願いできれば助かります！！

回答No.1

Mathmi · ベストアンサー

以下の条件で、簡単にコードを組んでみました。
・B2セルから下に、最低4個の数が連続して並んでいる。
・K列～N列に、4個の数字の組を抽出する。
・順列によるソートは行っていません。単純に抽出しただけです。

　再帰呼び出しを使えば、抽出する数も汎用化できると思います。

Sub test()
Dim i1 As Integer, i2 As Integer, i3 As Integer, i4 As Integer
Dim myRange As Range '抽出元範囲
Dim myCell As Range '出力先起点
Dim myRow As Integer '出力先行数

Set myRange = Range(Cells(2, 2), Cells(2, 2).End(xlDown))
Set myCell = Cells(1, 11)
myRow = 0

For i1 = 1 To myRange.Count - 3
For i2 = i1 + 1 To myRange.Count - 2
For i3 = i2 + 1 To myRange.Count - 1
For i4 = i3 + 1 To myRange.Count - 0
myCell.Offset(myRow, 0).Value = myRange(i1)
myCell.Offset(myRow, 1).Value = myRange(i2)
myCell.Offset(myRow, 2).Value = myRange(i3)
myCell.Offset(myRow, 3).Value = myRange(i4)
myRow = myRow + 1
Next i4
Next i3
Next i2
Next i1
End Sub

お礼

とてつもなくありがとうです！！
わかりやすいコードで助かりました！！

回答No.2

mt2015

作ってみました。
B列の数値の個数が18個まで対応出来ます。
取り出す個数を変える時は、コード中の「nSel = 4」の部分を変えてください。

Sub Sample()
　　nSel = 4　　'取り出す個数
　　nRow = 1　　'結果列挙の開始行
　　nDat = Range(Range("B2"), Range("B2").End(xlDown))
　　nCount = UBound(nDat)
　　For i = 1 To ((2 ^ nCount) - 1)
　　　　nUi = Int(i / 2 ^ 9)
　　　　nDi = i Mod 2 ^ 9
　　　　sBin = WorksheetFunction.Dec2Bin(nUi)
　　　　sBin = sBin & Right("000000000" & WorksheetFunction.Dec2Bin(nDi), 9)
　　　　sBinw = Replace(sBin, "0", "")
　　　　If Len(sBinw) = nSel Then
　　　　　　nCol = 11 '結果列挙の開始列（K)
　　　　　　nDCount = 1
　　　　　　For j = Len(sBin) To 1 Step -1
　　　　　　　　If Mid(sBin, j, 1) = "1" Then
　　　　　　　　　　Cells(nRow, nCol) = nDat(nDCount, 1)
　　　　　　　　　　nCol = nCol + 1
　　　　　　　　End If
　　　　　　　　nDCount = nDCount + 1
　　　　　　Next j
　　　　　　nRow = nRow + 1
　　　　End If
　　Next i
End Sub

お礼

ありがとうございます！！