趣味のエクセルマクロ&数字選択式宝くじ

ナンバーズ4などの数字選択式宝くじデータ分析用の自作マクロおよびナンバーズ4などの各種データリストなどをブログにしています。

LOTO6 ホットナンバー表示マクロ(案)

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


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


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


Dim y As Integer
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 Integer
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