LOTO6 ホットナンバー表示マクロ（案）

2018/11/10 15:40

ロト6のホットナンバー表示マクロを作成中ですが上手く行きませんｗ
（ビンゴ5のホットナンバー用マクロ応用しましたが、今回は赤い線で囲った部分がおかしいところになります　おかしいとこに共通的な面があるか推測しています）

ここでロト6のホットナンバーの定義は、ボーナス数字を含んで間隔が3以内で最低3回以上の出現を対象にマクロで赤色と下線表示とします。

上手く行かない原因は単純に私のマクロ作成スキル不足ですが、上の表を見ると間隔用の数字と本数字の●やボーナス数字の○が混在しています。
これらを踏まえてどうマクロ作成するかを考えたら良いかだと思います。

Dim y As long
Sub loto6_hot_no()
For x = 10 To 54
y = 3
Do Until Cells(y, 2) = ""
If Cells(y, x) = "" Then
   Cells(y + 1, x).Select

Else
    Cells(y, x).Select
    retu = ActiveCell.Column
     gyou = ActiveCell.Row
     gyoupoint = gyou

    If IsNumeric(Cells(gyou, retu).Value) = False Then

      For ii = 1 To 4
          Cells(gyou + ii, retu).Select
       j = ii
       If IsNumeric(Cells(gyou + j, retu).Value) = False Then Exit For
       y = y + 1
       Next ii

       If IsNumeric(Cells(gyou + j, retu).Value) = False And (WorksheetFunction.CountIf(Range(Cells(gyou + j, retu), Cells(gyou + j + 4, retu)), "〇") _
        + WorksheetFunction.CountIf(Range(Cells(gyou + j, retu), Cells(gyou + j + 4, retu)), "●")) >= 2 Then

        y = y - 2 'データ行ﾁｪｯｸの調整

         Cells(gyoupoint, retu).Select

         入力赤丸

        End If
    End If

End If

   y = y + 1

Loop
Next x

End Sub

Sub 入力赤丸()
Dim maruiti As Object

    retu = ActiveCell.Column
    gyou = ActiveCell.Row

Set maruiti = Application.Cells(gyou, retu)

jj = 1
If IsNumeric(Cells(gyou + jj, retu).Value) = True Then

     Do Until IsNumeric(Cells(gyou + jj, retu).Value) = False

      If jj > 3 Then Exit Do
     jj = jj + 1

    Loop

End If

      Cells(gyou + jj, retu).Select
    maruiti.Font.Underline = xlUnderlineStyleSingle
    maruiti.Font.Color = -16776961

   y = y + jj 'データ行ﾁｪｯｸの調整

If IsNumeric(Cells(gyou + jj, retu).Value) = True Then Exit Sub
入力赤丸

End Sub

以上のマクロでは問題があります。
難しいマクロに挑戦してスキルを上げたいです。毎日考えて行きたいですね！

力技で何とか上の表の様に出来ましたが？またまた問題が出て来ましたｗ

Dim y As long
Sub loto6_hot_no()

For x = 10 To 52
y = 3
Do Until Cells(y, 2) = ""

If Cells(y, x) = "" Then
   Cells(y + 1, x).Select

Else
    Cells(y, x).Select
    retu = ActiveCell.Column
     gyou = ActiveCell.Row
     gyoupoint = gyou

        If IsNumeric(Cells(gyou, retu).Value) = False Then

      For ii = 1 To 4

       Cells(gyou + ii, retu).Select
       j = ii
       If IsNumeric(Cells(gyou + j, retu).Value) = False Then Exit For
       y = y + 1

      Next ii

       If IsNumeric(Cells(gyou + j, retu).Value) = False And WorksheetFunction.Count(Range(Cells(gyou + j, retu), Cells(gyou + j + 4, retu))) <= 3 And _
       WorksheetFunction.CountIf(Range(Cells(gyou + j, retu), Cells(gyou + j + 3, retu)), "") = 0 Then

        y = y - 2 'データ行ﾁｪｯｸの調整

         Cells(gyoupoint, retu).Select

         入力赤丸

        End If
    End If

End If

   y = y + 1

     ' yasu
Loop

Next x

End Sub

Sub 入力赤丸()
Dim maruiti As Object

    retu = ActiveCell.Column
    gyou = ActiveCell.Row

Set maruiti = Application.Cells(gyou, retu)

         jj = 1
   If IsNumeric(Cells(gyou + jj, retu).Value) = True Then

     Do Until IsNumeric(Cells(gyou + jj, retu).Value) = False

      If jj > 3 Then Exit Do
     jj = jj + 1

    Loop

End If

    Cells(gyou + jj, retu).Select
    maruiti.Font.Underline = xlUnderlineStyleSingle
    maruiti.Font.Color = -16776961

   y = y + jj - 1 'データ行ﾁｪｯｸの調整

If IsNumeric(Cells(gyou + jj, retu).Value) = True Then Exit Sub
入力赤丸

End Sub

下の表の様に最後の行あたりでの表示が上手く行きません。（赤枠で囲った場所）
修正したマクロにまだおかしなところがありますね。

データの最後から最初に向かって処理するとか、その他に考えられるかどうかですね。