ぼんやりメモリー

日々感じたことやなるほど！などを、ぼんやりと残そうかな～

お年玉付き年賀はがきの当選番号チェック

備忘録 PC周辺

今年のお正月は珍しく雪がほとんど降らず、しかも妙に暖かかったのですが、先日の札幌周辺のドカ雪もあり、結局は平年並みの降雪・積雪状態となりました。

 

さて、1月17日はお年玉付き年賀ハガキの抽選日でありましたが、皆様の当選状況はいかがなものだったのでしょうか？

毎年、当選しているかどうかを調べるのが面倒だと思っていたのですが、エクセルのVBAで作ってみましたので、備忘録として残しておこうと思います。

シンプル・ダサダサですが、自分だけしか使わないし、１年に１回だけだし良しとします。

 

エクセルシートはこんな感じ（セル番地は必須です）。

当選番号をＩ列に入れときます。

 

そんでもって、Altキー+F11でVBA画面を開き、Sheet1のモジュール内に以下のコードをコピペ

　　　⇩

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    Application.EnableEvents = False
    
    ' A2セルにデータが入力された場合の処理
    If Target.Address = "$A$2" And Target.value <> "" Then
        Dim targetValue As String
        targetValue = Right(Target.value, 1) ' A2セルの下一桁目の数字を取得
        CheckMatch targetValue
    End If
    
    ' B2セルにデータが入力された場合の処理
    If Target.Address = "$B$2" And Target.value <> "" Then
        CheckMatch2Digits
    End If
    
    ' C2セルにデータが入力された場合の処理
    If Target.Address = "$C$2" And Target.value <> "" Then
        CheckMatch3Digits
    End If
    
    ' D2セルにデータが入力された場合の処理
    If Target.Address = "$D$2" And Target.value <> "" Then
        CheckMatch4Digits
    End If
    
    ' E2セルにデータが入力された場合の処理
    If Target.Address = "$E$2" And Target.value <> "" Then
        CheckMatch5Digits
    End If
    
    ' F2セルにデータが入力された場合の処理
    If Target.Address = "$F$2" And Target.value <> "" Then
        CheckMatch6Digits
    End If
    
    Application.EnableEvents = True
        If Err.Number <> 0 Then
        MsgBox "エラーが発生しました: " & Err.Description
    End If
    On Error GoTo 0
End Sub

Private Sub CheckMatch(ByVal targetValue As String)
    ' I1からI5セルのデータの下一桁目の数字と比較
    Dim iCell As Range
    Dim isMatch As Boolean
    isMatch = False

    For Each iCell In Range("I1:I5")
        If Right(iCell.value, 1) = targetValue Then
            isMatch = True
            Exit For
        End If
    Next iCell

    ' メッセージボックスの表示
    If isMatch Then
        MsgBox "当たっているかも？", vbOKOnly
    Else
        MsgBox "はずれ", vbExclamation
        ActiveSheet.Range("A2").ClearContents
        ActiveSheet.Range("A2").Select
    End If
End Sub

Private Sub CheckMatch2Digits()
    Dim combinedValue As Integer
    combinedValue = CInt(Right(ActiveSheet.Range("B2").value, 1) & Right(ActiveSheet.Range("A2").value, 1)) ' 逆にして合成
    
    ' I1からI5セルのデータの下2桁の数字と比較
    Dim iCell As Range
    Dim isMatch As Boolean
    isMatch = False

    For Each iCell In Range("I1:I5")
        If Right(iCell.value, 2) = Format(combinedValue, "00") Then
            isMatch = True
            Exit For
        End If
    Next iCell

    ' メッセージボックスの表示
    If Not isMatch Then
        MsgBox "はずれ", vbExclamation
        ActiveSheet.Range("A2:B2").ClearContents
        ActiveSheet.Range("A2").Select
    Else
        ' I3からI5セルの数値と合致しているか検証
        Dim iCell3to5 As Range
        Dim isMatch3to5 As Boolean
        isMatch3to5 = False

        For Each iCell3to5 In Range("I3:I5")
            If Format(combinedValue, "00") = Right(iCell3to5.value, 2) Then
                isMatch3to5 = True
                Exit For
            End If
        Next iCell3to5

        If isMatch3to5 Then
            MsgBox "3当に当選です。おめでとうございます！", vbInformation
        Else
            ' I1とI2セルの下二桁の数値と合致しているか検証
            Dim iCell1to2 As Range
            Dim isMatch1to2 As Boolean
            isMatch1to2 = False

            For Each iCell1to2 In Range("I1:I2")
                If Format(combinedValue, "00") = Right(iCell1to2.value, 2) Then
                    isMatch1to2 = True
                    Exit For
                End If
            Next iCell1to2

            If isMatch1to2 Then
                MsgBox "当たっているかも？", vbOKOnly
            Else
                MsgBox "はずれ", vbExclamation
                ActiveSheet.Range("A2:B2").ClearContents
                ActiveSheet.Range("A2").Select
            End If
        End If
    End If
End Sub

Private Sub CheckMatch3Digits()
    Dim combinedValue As Integer
    combinedValue = CInt(Right(ActiveSheet.Range("C2").value, 1) & Right(ActiveSheet.Range("B2").value, 1) & Right(ActiveSheet.Range("A2").value, 1)) ' 逆にして合成
    
    ' I1からI5セルのデータの下3桁の数字と比較
    Dim iCell As Range
    Dim isMatch As Boolean
    isMatch = False

    For Each iCell In Range("I1:I5")
        If Right(iCell.value, 3) = Format(combinedValue, "000") Then
            isMatch = True
            Exit For
        End If
    Next iCell

    ' メッセージボックスの表示
    If Not isMatch Then
        MsgBox "はずれ", vbExclamation
        ActiveSheet.Range("A2:C2").ClearContents
        ActiveSheet.Range("A2").Select
    Else
        ' I1とI2セルの下三桁の数値と合致しているか検証
        Dim iCell1to2 As Range
        Dim isMatch1to2 As Boolean
        isMatch1to2 = False

        For Each iCell1to2 In Range("I1:I2")
            If Format(combinedValue, "000") = Right(iCell1to2.value, 3) Then
                isMatch1to2 = True
                Exit For
            End If
        Next iCell1to2

        If isMatch1to2 Then
            MsgBox "ドキドキです！当たっているかも？", vbOKOnly
        Else
            MsgBox "はずれ", vbExclamation
            ActiveSheet.Range("A2:C2").ClearContents
            ActiveSheet.Range("A2").Select
        End If
    End If
End Sub

Private Sub CheckMatch4Digits()
    Dim combinedValue As Integer
    combinedValue = CInt(Right(ActiveSheet.Range("D2").value, 1) & Right(ActiveSheet.Range("C2").value, 1) & Right(ActiveSheet.Range("B2").value, 1) & Right(ActiveSheet.Range("A2").value, 1)) ' 逆にして合成
    
    ' I1からI5セルのデータの下4桁の数字と比較
    Dim iCell As Range
    Dim isMatch As Boolean
    isMatch = False

    For Each iCell In Range("I1:I5")
        If Right(iCell.value, 4) = Format(combinedValue, "0000") Then
            isMatch = True
            Exit For
        End If
    Next iCell

    ' メッセージボックスの表示
    If Not isMatch Then
        MsgBox "残念でした、はずれです", vbExclamation
        ActiveSheet.Range("A2:D2").ClearContents
        ActiveSheet.Range("A2").Select
    Else
        ' I2セルの下四桁の数値と合致しているか検証
        Dim iCell2 As Range
        Dim isMatch2 As Boolean
        isMatch2 = False

        For Each iCell2 In Range("I2:I2")
            If Format(combinedValue, "0000") = Right(iCell2.value, 4) Then
                isMatch2 = True
                Exit For
            End If
        Next iCell2

        If isMatch2 Then
            MsgBox "やりました！2当に当選です。おめでとうございます！", vbInformation
        Else
            ' I1セルの下四桁の数値と合致しているか検証
            Dim iCell1 As Range
            Dim isMatch1 As Boolean
            isMatch1 = False

            For Each iCell1 In Range("I1:I1")
                If Format(combinedValue, "0000") = Right(iCell1.value, 4) Then
                    isMatch1 = True
                    Exit For
                End If
            Next iCell1

            If isMatch1 Then
                MsgBox "ワー！当たっているかも？", vbOKOnly
            Else
                MsgBox "はずれ", vbExclamationa2
                ActiveSheet.Range("A2:D2").ClearContents
                ActiveSheet.Range("A2").Select
            End If
        End If
    End If
End Sub

Private Sub CheckMatch5Digits()
    Dim combinedValue As Long
    Dim targetValue As String
    Dim isMatch As Boolean
    
    targetValue = Right(ActiveSheet.Range("E2").value, 1) & _
                  Right(ActiveSheet.Range("D2").value, 1) & _
                  Right(ActiveSheet.Range("C2").value, 1) & _
                  Right(ActiveSheet.Range("B2").value, 1) & _
                  Right(ActiveSheet.Range("A2").value, 1)
    
    If Len(targetValue) = 5 Then
        combinedValue = CLng(targetValue) ' Convert to Long
    Else
        ' Handle error or inform the user
        MsgBox "Invalid input length for 5 digits", vbExclamation
        Exit Sub
    End If

    ' I1セルの下5桁の数字と合致するかどうか検証
    isMatch = (combinedValue = CLng(Right(ActiveSheet.Range("I1").value, 5)))

    ' メッセージボックスの表示
    If Not isMatch Then
        MsgBox "残念でした、はずれです", vbExclamation
        ActiveSheet.Range("A2:E2").ClearContents
        ActiveSheet.Range("A2").Select
    Else
        MsgBox "ドキドキです！１当に当たっているかも？", vbOKOnly
    End If
End Sub

Private Sub CheckMatch6Digits()
    Dim combinedValue As Long
    Dim targetValue As String
    Dim isMatch As Boolean
    
    targetValue = Right(ActiveSheet.Range("F2").value, 1) & _
                  Right(ActiveSheet.Range("E2").value, 1) & _
                  Right(ActiveSheet.Range("D2").value, 1) & _
                  Right(ActiveSheet.Range("C2").value, 1) & _
                  Right(ActiveSheet.Range("B2").value, 1) & _
                  Right(ActiveSheet.Range("A2").value, 1)

    If Len(targetValue) = 6 Then
        combinedValue = CLng(targetValue) ' Convert to Long
    Else
        ' Handle error or inform the user
        MsgBox "Invalid input length for 6 digits", vbExclamation
        Exit Sub
    End If
    
    ' I1セルの数値と合致するかどうか検証
    isMatch = (combinedValue = CLng(ActiveSheet.Range("I1").value))

    ' メッセージボックスの表示
    If Not isMatch Then
        MsgBox "あ～残念でした！、惜しくもはずれです", vbExclamation
        ActiveSheet.Range("A2:F2").ClearContents
        ActiveSheet.Range("A2").Select
    Else
        MsgBox "凄いです！見事１当に当選です！おめでとうございます！！", vbInformation
    End If
End Sub

 

 

 

それから、シート上に作った数値クリアボタンに貼り付けるコードがこれ

　　　⇩
Sub 数値クリアボタン()
'
' シートのA2からF2セルをひとつづクリアしてA2セルにフォーカスあてる
    Range("A2").Select
    Selection.ClearContents
    Range("B2").Select
    Selection.ClearContents
    Range("C2").Select
    Selection.ClearContents
    Range("D2").Select
    Selection.ClearContents
    Range("E2").Select
    Selection.ClearContents
    Range("F2").Select
    Selection.ClearContents
    Range("A2").Select
End Sub

あとは、年賀ハガキの番号の下一桁目から順に入力してチェックさせるスタイルです。

他の人に下一桁から順番に読んでもらい、もう一人がそれを入力するように出来れば結構早くチェックを進めることが出来ますが、一人の場合だとこれを使わず目で確認した方が早いというオチでした。ちゃんちゃん。

結構苦労して作ったんですけど、トホホのホ。

 

年々、送る年賀状の枚数が減っている昨今ですが、今年は切手シートが３枚当選しておりました。めでたしめでたし！

 

今日も良い１日になりますように！