Option Explicit
Option Base 1
Public yosou(), yosousuu, lot7(), kumiawasesuu As Long, dai1, dai2, dai3, dai4, dai5, dai6, dai7
Public linesuu As Long, irow, icol, keta, ix, iy
Sub 動作チェック用無料サンプルプログラム()
Worksheets("予想数字の選択").Activate
yosousuu = 0
For irow = 1 To 7
For icol = 1 To 7
If Cells(irow, icol).Interior.ColorIndex > 0 Then yosousuu = yosousuu + 1
Next icol
Next irow
ReDim yosou(yosousuu)
ix = 0
For irow = 1 To 7
For icol = 1 To 7
If Cells(irow, icol).Interior.ColorIndex > 0 Then
ix = ix + 1
yosou(ix) = Cells(irow, icol).Value
End If
Next icol
Next irow
kumiawasesuu = Application.WorksheetFunction.Combin(yosousuu, 7)
ReDim lot7(kumiawasesuu, 7)
dai1 = 1
dai2 = 2
dai3 = 3
dai4 = 4
dai5 = 5
dai6 = 6
linesuu = 0
Gsyokiti:
dai7 = dai6 + 1
Call dainyuu
Do Until dai7 = yosousuu
dai7 = dai7 + 1
Call dainyuu
Loop
If dai6 <> yosousuu - 1 Then
dai6 = dai6 + 1
GoTo Gsyokiti
End If
If dai5 <> yosousuu - 2 Then
dai5 = dai5 + 1
dai6 = dai5 + 1
GoTo Gsyokiti
End If
If dai4 <> yosousuu - 3 Then
dai4 = dai4 + 1
dai5 = dai4 + 1
dai6 = dai5 + 1
GoTo Gsyokiti
End If
If dai3 <> yosousuu - 4 Then
dai3 = dai3 + 1
dai4 = dai3 + 1
dai5 = dai4 + 1
dai6 = dai5 + 1
GoTo Gsyokiti
End If
If dai2 <> yosousuu - 5 Then
dai2 = dai2 + 1
dai3 = dai2 + 1
dai4 = dai3 + 1
dai5 = dai4 + 1
dai6 = dai5 + 1
GoTo Gsyokiti
End If
If dai1 <> yosousuu - 6 Then
dai1 = dai1 + 1
dai2 = dai1 + 1
dai3 = dai2 + 1
dai4 = dai3 + 1
dai5 = dai4 + 1
dai6 = dai5 + 1
GoTo Gsyokiti
End If
ix = MsgBox("正常に動作しました。" & CStr(yosousuu) & "個から7個取る組合せは、" & CStr(kumiawasesuu) & _
"組 です。組合せをシートに出力しますか？", vbQuestion + vbYesNo)
If ix = vbNo Then
Worksheets("予想数字の選択").Activate
GoTo Finish
End If
Call sheetclear("当選確率の高い組合せ")
For linesuu = 1 To kumiawasesuu
For keta = 1 To 7
Cells(linesuu, keta).Value = lot7(linesuu, keta)
Next keta
Next linesuu
Range("A1:G" & CStr(kumiawasesuu)).Font.Bold = True
Finish:
End Sub
Sub dainyuu()
linesuu = linesuu + 1
lot7(linesuu, 1) = yosou(dai1)
lot7(linesuu, 2) = yosou(dai2)
lot7(linesuu, 3) = yosou(dai3)
lot7(linesuu, 4) = yosou(dai4)
lot7(linesuu, 5) = yosou(dai5)
lot7(linesuu, 6) = yosou(dai6)
lot7(linesuu, 7) = yosou(dai7)
End Sub
Sub sheetclear(sheetname)
Worksheets(sheetname).Activate
Range("A:A").Clear
Range("B:B").Clear
Range("C:C").Clear
Range("D:D").Clear
Range("E:E").Clear
Range("F:F").Clear
Range("G:G").Clear
End Sub