オイラはナンバーズ4を購入しています。
毎回抽選ナンバーを手で入力してその後も手で入力しています。
こんな感じです。
これを最初の抽選番号を入れるだけで全て完了できるようにAIに相談しました。
一気にやりたいことを書くことは難しいので少しづつ相談（命令）していき
完成まで持って行きました。
ただ一番最初にマクロが動くまでされるのが相当時間がかかりました。
オイラの方でスクリーンショットを色々撮りAIに送り解決できました。
そしてマクロが動かない原因が分かりその後は一気に進めていきました。
原因はマクロの式を入れるところが間違っていたということでした。
マクロの式は相当な長い式になりました。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim numStr As String
Dim i As Integer
Dim digit As Integer
Dim targetCol As Integer
Dim countArr(0 To 9) As Integer
Dim prevRow As Long
Dim checkCol As Integer
Dim cellVal As String
' AJ～AS列の並び替え用変数
Dim hitDigits() As Variant
Dim missDigits() As Variant
Dim hitCount As Integer
Dim missCount As Integer
Dim currentIdx As Integer
' O～R列、Y～AB列のチェック用変数
Dim matchCountOR As Integer
Dim matchCountYAB As Integer
' 変更されたセルがC列かつ、587行目以降の単一セルであるか確認
If Target.Column = 3 And Target.Row >= 587 And Target.Count = 1 Then
If Target.Value <> "" Then
numStr = Right("0000" & Trim(Target.Value), 4)
If numStr Like "[0-9][0-9][0-9][0-9]" Then
Application.EnableEvents = False
' ==========================================================
' 1. D列?M列のカラー展開
' ==========================================================
With Range(Cells(Target.Row, 4), Cells(Target.Row, 13))
.ClearContents
.Interior.Color = xlNone
End With
For i = 1 To 4
digit = CInt(Mid(numStr, i, 1))
countArr(digit) = countArr(digit) + 1
Next i
For i = 0 To 9
If countArr(i) > 0 Then
targetCol = 4 + i
Select Case countArr(i)
Case 1: Cells(Target.Row, targetCol).Interior.Color = RGB(255, 255, 0)
Case 2: Cells(Target.Row, targetCol).Interior.Color = RGB(255, 0, 0)
Case 3, 4: Cells(Target.Row, targetCol).Interior.Color = RGB(0, 112, 192)
End Select
End If
Next i
' ==========================================================
' 2. AJ列?AS列の【上の段の装飾】＆【下の段への並び替え】
' ==========================================================
prevRow = Target.Row - 1
ReDim hitDigits(1 To 10)
ReDim missDigits(1 To 10)
hitCount = 0
missCount = 0
For checkCol = 36 To 45 ' AJ列(36) ? AS列(45)
With Cells(prevRow, checkCol)
.Font.ColorIndex = xlAutomatic
.Font.Bold = False
.Interior.Color = xlNone
.BorderAround LineStyle:=xlNone
If .Value <> "" And IsNumeric(.Value) Then
cellVal = Trim(CStr(.Value))
If InStr(numStr, cellVal) > 0 Then
digit = CInt(cellVal)
.Font.Color = RGB(255, 0, 0)
.Font.Bold = True
.BorderAround LineStyle:=xlContinuous, Weight:=xlThick, Color:=RGB(255, 0, 0)
If countArr(digit) >= 2 Then
.Interior.Color = RGB(255, 255, 0)
End If
hitCount = hitCount + 1
hitDigits(hitCount) = digit
Else
missCount = missCount + 1
missDigits(missCount) = CInt(cellVal)
End If
End If
End With
Next checkCol
' 下の段（現在の行）のAJ?AS列をクリアして通常黒文字で配置
With Range(Cells(Target.Row, 36), Cells(Target.Row, 45))
.Font.ColorIndex = xlAutomatic
.Font.Bold = False
.Interior.Color = xlNone
.ClearContents
For checkCol = 36 To 45
Cells(Target.Row, checkCol).BorderAround LineStyle:=xlNone
Next checkCol
End With
currentIdx = 36
If hitCount > 0 Then
For i = 1 To hitCount
Cells(Target.Row, currentIdx).Value = hitDigits(i)
currentIdx = currentIdx + 1
Next i
End If
If missCount > 0 Then
For i = 1 To missCount
Cells(Target.Row, currentIdx).Value = missDigits(i)
currentIdx = currentIdx + 1
Next i
End If
' ==========================================================
' 3. O列?R列（予想番号）、Y列?AB列（2点目買い）のチェック処理
' ==========================================================
' --- O列?R列 (15列目?18列目) の処理 ---
matchCountOR = 0
' まず既存の背景色と外枠をリセット
Range(Cells(Target.Row, 15), Cells(Target.Row, 18)).Interior.Color = xlNone
Range(Cells(Target.Row, 15), Cells(Target.Row, 18)).Borders.LineStyle = xlNone
For checkCol = 15 To 18
With Cells(Target.Row, checkCol)
If .Value <> "" And IsNumeric(.Value) Then
If InStr(numStr, Trim(CStr(.Value))) > 0 Then
.Interior.Color = RGB(255, 255, 0) ' 一致したらセルを黄色にする
matchCountOR = matchCountOR + 1
End If
End If
End With
Next checkCol
' 3つ以上黄色いセル（的中）があったら大きな極太赤枠で囲む
If matchCountOR >= 3 Then
Range(Cells(Target.Row, 15), Cells(Target.Row, 18)).BorderAround _
LineStyle:=xlContinuous, Weight:=xlThick, Color:=RGB(255, 0, 0)
End If
' --- Y列?AB列 (25列目?28列目) の処理 ---
matchCountYAB = 0
' まず既存の背景色と外枠をリセット
Range(Cells(Target.Row, 25), Cells(Target.Row, 28)).Interior.Color = xlNone
Range(Cells(Target.Row, 25), Cells(Target.Row, 28)).Borders.LineStyle = xlNone
For checkCol = 25 To 28
With Cells(Target.Row, checkCol)
If .Value <> "" And IsNumeric(.Value) Then
If InStr(numStr, Trim(CStr(.Value))) > 0 Then
.Interior.Color = RGB(255, 255, 0) ' 一致したらセルを黄色にする
matchCountYAB = matchCountYAB + 1
End If
End If
End With
Next checkCol
' 3つ以上黄色いセル（的中）があったら大きな極太赤枠で囲む
If matchCountYAB >= 3 Then
Range(Cells(Target.Row, 25), Cells(Target.Row, 28)).BorderAround _
LineStyle:=xlContinuous, Weight:=xlThick, Color:=RGB(255, 0, 0)
End If
Application.EnableEvents = True
End If
End If
End If
End Sub
これを自分で書くならば1年経ってもできないでしょう。
0 件のコメント:
コメントを投稿