ドットコム・パソコン塾のブログ -50ページ目

Excelのお話　Part4

こんにちは～ドットコムパソコン塾の徳丸です

今日もExcelのマクロのお話です

Excelを嫌いにならないでくださいね

プログラムを組むと本当に毎日の作業が楽になります

今回紹介させていただくのは～

競馬の3連複と3連単の組み合わせの問題です。

3連複は着順は決めない（順不同）、1位～3位に入賞する馬番を予想するものです。

3連単は着順も同じでないといけません

頭の馬番から流して予想する馬が5つとかあると重複する馬番がでないように

組み合わせたりと難しいので（私はですけど（笑））

そこで、マクロで処理してみました。

下図のように3連複では、B列に絶対にこの馬が入賞するだろうと思う馬番を入力します。

C列にはその後に続くだろう馬番の予想をいくつか入力します。

その後3連複のボタンをポチッとクリックするとD・E・Fに購入する馬番が表示されます。

3連単も同じような要領で入力します。

上記にも述べたように、3連単は順位も同一でなければいけませんので購入する枚数が増えますね～

競馬は1枚100円なので、G列・N列に購入枚数と金額が表示されるようにしています。

プログラムは以下のようにコードの表示から、標準モジュールにマクロを記載します。

上記の表を同じように作成して、標準モジュールに以下のマクロをコピペしてみてください。

面白いので是非お試しください

Option Explicit

Sub 三連複_頭流し頭()
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim cnt1 As Long
    Dim cnt2 As Long
    Dim cnt3 As Long

    If Application.Count(Columns(2)) Then
        Application.ScreenUpdating = False
        Range("D3:F10000").ClearContents
        cnt1 = Cells(Rows.Count, 2).End(xlUp).Row
        cnt2 = Cells(Rows.Count, 3).End(xlUp).Row
        cnt3 = 3
        Range("D1,D3:F1000") = ""
        For i = 3 To cnt1
            For j = 3 To cnt2
                For k = j + 1 To cnt2
                    Cells(cnt3, 4) = Cells(i, 2)
                    Cells(cnt3, 5) = Cells(j, 3)
                    Cells(cnt3, 6) = Cells(k, 3)
                    cnt3 = cnt3 + 1
                Next
            Next
        Next
        Application.ScreenUpdating = True
    Else
        Call 重複なし組合せ
    End If
End Sub

Sub 三連単_頭流し頭()
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim cnt1 As Long
    Dim cnt2 As Long
    Dim cnt3 As Long

    If Application.Count(Columns(9)) Then
        Application.ScreenUpdating = False
        Range("K3:M10000").ClearContents
        cnt1 = Cells(Rows.Count, 9).End(xlUp).Row
        cnt2 = Cells(Rows.Count, 10).End(xlUp).Row
        cnt3 = 3
        For i = 3 To cnt1
            For j = 3 To cnt2
                For k = 3 To cnt2
                    If Cells(j, 10) <> Cells(k, 10) Then
                        Cells(cnt3, 11).Value = Cells(i, 9)
                        Cells(cnt3, 12).Value = Cells(j, 10)
                        Cells(cnt3, 13).Value = Cells(k, 10)
                        cnt3 = cnt3 + 1
                    End If
                Next k
            Next j
        Next i
        Application.ScreenUpdating = True
    Else
        Call 重複あり組合せ
    End If
End Sub

Sub 重複なし組合せ()
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim cnt As Long
    Dim cnt1 As Long

    Application.ScreenUpdating = False
    cnt1 = Cells(Rows.Count, 3).End(xlUp).Row
    cnt = 3
    For i = 3 To cnt1
        For j = i + 1 To cnt1
            For k = j + 1 To cnt1
                Cells(cnt, 4) = Cells(i, 3)
                Cells(cnt, 5) = Cells(j, 3)
                Cells(cnt, 6) = Cells(k, 3)
                cnt = cnt + 1
            Next
        Next
    Next
End Sub

Sub 重複あり組合せ()
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim cnt1 As Long
    Dim cnt2 As Long
    Dim cnt3 As Long

    Application.ScreenUpdating = False
    Range("K3:M10000").ClearContents
    cnt2 = Cells(Rows.Count, 10).End(xlUp).Row
    cnt3 = 3
    For i = 3 To cnt2
        For j = 3 To cnt2
            For k = 3 To cnt2
                If Cells(i, 10) <> Cells(j, 10) And Cells(i, 10) <> Cells(k, 10) And Cells(j, 10) <> Cells(k, 10) Then
                    Cells(cnt3, 11).Value = Cells(i, 10)
                    Cells(cnt3, 12).Value = Cells(j, 10)
                    Cells(cnt3, 13).Value = Cells(k, 10)
                    cnt3 = cnt3 + 1
                End If
            Next k
        Next j
    Next i
    Application.ScreenUpdating = True
End Sub

いかがですか？

㊟こちらは知恵袋での解答ではありません（笑）

ご質問はコメント欄よりお願いいたします

HPはこちらから

〒503-0204
岐阜県安八郡輪之内町四郷211-1
ドットコム・パソコン塾
TEL：0584-69-3839
開校日：月曜日～土曜日8：00～13：00
プライベートレッスン：月曜日～土曜日13：00～17：00
休校日：日曜日・祝日

Excelのお話 Part4

Excelのお話　Part4