こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

VBA 組み合わせ表示

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

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

投稿日時 - 2018-06-06 12:00:27

QNo.9505624

すぐに回答ほしいです

質問者が選んだベストアンサー

以下の条件で、簡単にコードを組んでみました。
・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

投稿日時 - 2018-06-06 14:58:49

お礼

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

投稿日時 - 2018-06-06 16:17:48

ANo.1

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(2)

ANo.2

作ってみました。
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

投稿日時 - 2018-06-06 16:20:51

お礼

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

投稿日時 - 2018-06-06 16:29:35