Excel（エクセル）活用コミュのＷＩＮ５という馬券用の買い目表の作成について

面倒なので斜め読みしかしていませんが、条件に沿った組み合わせを
生成するだけなら、VBAでも使えば多少手間はかかるでしょうけど
難しい事では無いと思います。

やる事は長さ5の集合のうち、各位置で使える候補値に一定の制限を
かけただけで、処理効率を気にしなければ全組み合わせから不要候補を
省く判定処理をするだけでしょうから、問題としての面白みも無いです。
(せいぜい、情報学科1年後期の演習問題程度の難度？)

関数式でやれ、という条件なら私ならやりたくないですし、
ご自身で作るのではなく、「誰かが作れ」という丸投げなら
相手をしたくありませんが…。

＞Minon様

早々にお答えいただきありがとうございます。

今の私の知識ではＶＢＡというのはハードルが高すぎましてちんぷんかんぷんです。

ですがＶＢＡを理解し使えるようになれば、アドバイスいただいた処理をして行けば問題が解決できるということは理解ができました。

まず自分でＶＢＡについて学習し作成することから始めるべきなのが当然だと思いますが、今の私の実力ではＶＢＡを理解するのに膨大な時間を費やしそうなので、ＶＢＡを使わず個別に入力しながら対応していくほうが早いぐらいだと思います。

ただそもそもエクセルで質問内容が処理できるのかも分からなかったですし、何を使えば良いかも分からなかったので、大まかな筋道を教えていただけで非常に助かりました。

ありがとうございました。

とりあえず、出力を最適化していない手抜き版のマクロを書いてみました。
↓のような感じにデータを入力してマクロを実行すると、組み合わせが出力
されます。ただし、手抜きのせいで出力が冗長です(シート枚数が多めになります)
良いお手本には程遠いですが、参考までに…。

　A　　　B　　　　C　　　　D　　　　E　　　　F
1 ◎の数 3 出力先 a7
2 1R 2R 3R 4R 5R
3◎ 2 11 3 7 5
4○ 4 9 6 3 8
5▲ 6 2 8 9 1



Option Explicit
'ＷＩＮ５という馬券用の買い目表の作成について
'http://mixi.jp/view_bbs.pl?id=64359334&comment_count=2&comm_id=2106
'の実装例(手抜きなので出力が最適化されていないver.)

Sub MakeVoting()
'本体マクロを呼び出す
' 引数は、順に、<◎を含める数>,<馬番データの範囲>,<出力位置>
Call MakeVotingCombi("B1", "B3:F5", "A7")
End Sub

'投票する組み合わせ(テキスト)を生成し出力する
'sNum:最低含めるべき◎の数　rSrc:入力した馬番データ範囲文字列　rDest:組み合わせ出力位置文字列
Sub MakeVotingCombi(sNum As String, sSrc As String, sDest As String)
Dim n As Integer
Dim rSrc As Range
Dim rDest As Range
Dim i As Integer, j As Integer, k As Integer, l As Integer, m As Integer
Dim sTmp As String
Dim sHNum() As String '出力用馬番格納用配列(レース番号, 1:◎馬番 2:非◎馬番)
Dim iRaces As Integer
Dim iHorses As Integer
Dim iRowPos As Integer
Dim nVotesSum As Long '総投票数
Dim nVotesSub As Long 'その組み合わせでの投票数
Dim nVotes() As Integer '投票数格納用配列
Dim bIsEmpty As Boolean

'前処理(各桁の◎と非◎を示す文字列配列を生成)
n = ActiveSheet.Range(sNum)
Set rSrc = ActiveSheet.Range(sSrc)
Set rDest = ActiveSheet.Range(sDest)
iRaces = rSrc.Columns.Count
iHorses = rSrc.Rows.Count
ReDim sHNum(iRaces, 2) As String
ReDim nVotes(iRaces, 2) As Integer
For i = 1 To iRaces
sHNum(i, 1) = Format(rSrc.Cells(1, i).Value, "00")
nVotes(i, 1) = 1
sTmp = ""
For j = 2 To iHorses
k = Val(rSrc.Cells(j, i).Value)
If k = 0 Then Exit For
If j > 2 Then sTmp = sTmp & ", "
sTmp = sTmp & Format(k, "00")
Next j
sHNum(i, 2) = sTmp
nVotes(i, 2) = j - 2
Next i
'この問題の組み合わせ生成は、
'各桁、"◎"と"非◎"の2値要素についての組み合わせなので
'0から(2のiRaces乗-1)までの整数値のうち、
'2進数表記した際に0となる桁の個数がn以上である数を
'抽出する問題と同義。
'　※出力は最適化されていない。。。

'出力
iRowPos = 1
For i = 0 To 2 ^ iRaces - 1
k = i
l = 0 '2進数表記での1の個数
sTmp = ""
nVotesSub = 1
bIsEmpty = False
For j = 1 To iRaces
m = k And 1 'その桁の値0or1
l = l + m
k = Int(k / 2)
If sHNum(j, m + 1) = "" Then bIsEmpty = True
sTmp = sTmp & sHNum(j, m + 1)
nVotesSub = nVotesSub * nVotes(j, m + 1)
If j < iRaces Then sTmp = sTmp & " → "
Next j
'(0の個数がn以上＝1の個数がiRaces-n以下)かつ入力に空欄が無い場合は出力する
If (l <= iRaces - n) And bIsEmpty = False Then
rDest.Cells(iRowPos, 1).Value = sTmp
nVotesSum = nVotesSum + nVotesSub '投票数を加算
iRowPos = iRowPos + 1
End If
Next i
rDest.Cells(iRowPos, 1).Value = "投票数 = " & nVotesSum
End Sub

問題の規模の小ささに甘えて賢いアルゴリズムからは程遠い
手抜きコードですが、出力の冗長さを取り除いてみました。
これで一応、当初の要望を満たした事になると思います。


's1st+sMid+s2ndとなる文字列を返す。ただし、s1stかs2ndが空文字列なら他方のみを返す
Private Function CombineStr(s1st As String, s2nd As String, sMid As String) As String
If s1st = "" Then
CombineStr = s2nd
ElseIf s2nd = "" Then
CombineStr = s1st
Else
CombineStr = s1st & sMid & s2nd
End If
End Function

'投票する組み合わせ(テキスト)を生成し出力する
'sNum:最低含めるべき◎の数　rSrc:入力した馬番データ範囲文字列　rDest:組み合わせ出力位置文字列
Sub MakeVotingCombi(sNum As String, sSrc As String, sDest As String)
Dim n As Integer
Dim rSrc As Range
Dim rDest As Range
Dim i As Integer, j As Integer, k As Integer, l As Integer, m As Integer
Dim sTmp As String
Dim sHNum() As String '出力用馬番格納用配列(レース番号, 1:◎馬番 2:非◎馬番 3:両方)
Dim iRaces As Integer
Dim iHorses As Integer
Dim iRowPos As Integer
Dim nVotesSum As Long '総投票数
Dim nVotesSub As Long 'その組み合わせでの投票数
Dim nVotes() As Integer '投票数格納用配列
Dim bIsEmpty As Boolean
Dim bUsed() As Boolean '既に利用済か否か
Dim colVotes As New Collection '出力用の要素を格納するコレクション

'前処理(各桁の◎と非◎を示す文字列配列を生成)
n = ActiveSheet.Range(sNum)
Set rSrc = ActiveSheet.Range(sSrc)
Set rDest = ActiveSheet.Range(sDest)
iRaces = rSrc.Columns.Count
iHorses = rSrc.Rows.Count
ReDim sHNum(iRaces, 3) As String
ReDim nVotes(iRaces, 3) As Integer
For i = 1 To iRaces
sHNum(i, 1) = Format(rSrc.Cells(1, i).Value, "00")
nVotes(i, 1) = 1
sTmp = ""
For j = 2 To iHorses
k = Val(rSrc.Cells(j, i).Value)
If k = 0 Then Exit For
sTmp = CombineStr(sTmp, Format(k, "00"), ", ")
Next j
sHNum(i, 2) = sTmp
nVotes(i, 2) = j - 2
sHNum(i, 3) = CombineStr(sHNum(i, 1), sHNum(i, 2), ", ")
nVotes(i, 3) = nVotes(i, 1) + nVotes(i, 2)
Next i
'この問題の組み合わせ生成は、
'各桁、"◎"と"非◎"の2値要素についての組み合わせなので
'0から(2のiRaces乗-1)までの整数値のうち、
'2進数表記した際に0となる桁の個数がn以上である数を
'抽出する問題と同義。

'出力判定
iRowPos = 1
For i = 0 To 2 ^ iRaces - 1
k = i
l = 0 '2進数表記での1の個数
sTmp = ""
nVotesSub = 1
bIsEmpty = False
For j = 1 To iRaces
m = k And 1 'その桁の値0or1
l = l + m
k = Int(k / 2)
If sHNum(j, m + 1) = "" Then bIsEmpty = True
sTmp = sTmp & CStr(m)
Next j
'(0の個数がn以上＝1の個数がiRaces-n以下)かつ入力に空欄が無い場合は
'出力対象とし、コレクションに追加する
If (l <= iRaces - n) And bIsEmpty = False Then
colVotes.Add Item:=sTmp, Key:=sTmp
End If
Next i
'続く

'>>4の続き

'冗長な要素を結合
Dim a As Variant, b As Variant
Dim bCombined As Boolean
Dim iMatched As Integer
Do
bCombined = False
For Each a In colVotes
For Each b In colVotes
iMatched = 0
For i = 1 To iRaces
If Mid(a, i, 1) = Mid(b, i, 1) Then iMatched = iMatched + 1
Next i
'1成分のみ異なる要素対が見つかったら結合する
If iMatched = iRaces - 1 And iMatched > 0 Then
For i = 1 To iRaces
'
If Mid(a, i, 1) <> Mid(b, i, 1) Then
If Mid(a, i, 1) <> "2" And Mid(b, i, 1) <> "2" Then
sTmp = a
Mid(sTmp, i, 1) = "2" '◎＋非◎成分を示す値を仮に2とする
'既存要素を削除し、新要素をコレクションに追加
colVotes.Remove a
colVotes.Remove b
colVotes.Add Item:=sTmp, Key:=sTmp
bCombined = True
Exit For
End If
End If
Next i
End If
If bCombined = True Then Exit For
Next
If bCombined = True Then Exit For
Next
Loop While bCombined = True

'出力
For Each a In colVotes
sTmp = ""
nVotesSub = 1
For i = 1 To iRaces
j = Val(Mid(a, i, 1))
sTmp = CombineStr(sTmp, sHNum(i, j + 1), " → ")
nVotesSub = nVotesSub * nVotes(i, j + 1)
Next i
rDest.Cells(iRowPos, 1).Value = sTmp
nVotesSum = nVotesSum + nVotesSub
iRowPos = iRowPos + 1
Next a
rDest.Cells(iRowPos, 1).Value = "投票数 = " & nVotesSum
End Sub

＞Minon様

まず返信が遅くなり大変申し訳ありませんでした。

貴重なお時間を割いて、また親切に教えていただきありがとうございます。

私のほうはそもそも引数とは何ぞや？
マクロを起動するには？

というレベルなのでまだまだ完成には至らないです。
（ちなみに引数の意味は分かりました）

しかしこれだけ教えていただいたので時間が掛かろうとも必ず仕上げます。

本当にありがとうございます。