記事目次　ナンバーズ4

変数　知らなかった本当の使い方 

Sub kiguu間隔() '奇遇表示と奇偶間隔でアンダーバー引く  （ 16パターンの間隔）
Dim i As long, k As long, gyou As long, kiguu As long
Dim kiguin As String
Dim kiguubar As Range, diguubar As Range
Worksheets("パターン表").Select
gyou = ActiveCell.Row
If ActiveCell.Column <> 82 Then End
kiguu = Cells(gyou, 82)’奇遇パターン
Set dkiguubar = Application.Cells(gyou, 26)
Set kiguubar = Application.Cells(gyou, 82)
 i = 1
Do Until kiguu = Cells(gyou - i, 82)　’間隔計算する　
  i = i + 1
  k = i - 1
 If i = 3000 Then Exit Do
Loop
If k < 17 Then'出現間隔が16回以下の時　下線無
    kiguubar.Font.Underline = xlUnderlineStyleNone
   dkiguubar.Font.Underline = xlUnderlineStyleNone
ElseIf k >= 17 And k < 32 Then'出現間隔が17回以上31回以下の時　下線有り
    kiguubar.Font.Underline = xlUnderlineStyleSingle
   dkiguubar.Font.Underline = xlUnderlineStyleSingle
Else　'出現間隔が32回以上の時　二重下線にする
  kiguubar.Font.Underline = xlUnderlineStyleDouble
  dkiguubar.Font.Underline = xlUnderlineStyleDouble
End If
Select Case kiguu
 Case 1:  kiguin = "△△△△"
 Case 2:  kiguin = "▲▲▲▲"
 Case 3:  kiguin = "△△△▲"
 Case 4:  kiguin = "△△▲△"
 Case 5:  kiguin = "△▲△△"
 Case 6:  kiguin = "▲△△△"
 Case 7:  kiguin = "▲▲▲△"
 Case 8:  kiguin = "▲▲△▲"
 Case 9:  kiguin = "▲△▲▲"
 Case 10:  kiguin = "△▲▲▲"
 Case 11:  kiguin = "△△▲▲"
 Case 12:  kiguin = "△▲△▲"
 Case 13:  kiguin = "△▲▲△"
 Case 14:  kiguin = "▲▲△△"
 Case 15:  kiguin = "▲△▲△"
 Case 16:  kiguin = "▲△△▲"
End Select
 Cells(gyou, 81) = kiguin’奇遇表示
 ' kiguu間隔
End Sub
マクロ学習法とは 7 （条件分析）

ナンバーズ4出目の奇数偶数（5083回）
--------------------------------------------------------------------------------------------------------

Sub daisyo間隔() '大小間隔でアンダーバー引く（16パターンでの確率で）
Dim i As long, k As long, gyou As long, daisyo As long
Dim daisyobar As Range, ndaisyobar As Range
Dim daisy As String
Worksheets("パターン表").Select
gyou = ActiveCell.Row
If ActiveCell.Column <> 34 Then End
daisyo = Cells(gyou, 34)
Set daisyobar = Application.Cells(gyou, 34)
Set ndaisyobar = Application.Cells(gyou, 79)
   i = 1
Do Until daisyo = Cells(gyou - i, 34)
  i = i + 1
  k = i - 1
 If i = 3000 Then Exit Do
Loop
If k < 17 Then’（出現間隔が16回以内の場合）
  daisyobar.Font.Underline = xlUnderlineStyleNone
  ndaisyobar.Font.Underline = xlUnderlineStyleNone
ElseIf k >= 17 And k <= 32 Then
  daisyobar.Font.Underline = xlUnderlineStyleSingle
  ndaisyobar.Font.Underline = xlUnderlineStyleSingle
Else
 daisyobar.Font.Underline = xlUnderlineStyleDouble
 ndaisyobar.Font.Underline = xlUnderlineStyleDouble
End If
If daisyo = 1 Or daisyo = 0 Then
 daisy = "□□□□"
ElseIf daisyo = 2 Then
 daisy = "■■■■"
ElseIf daisyo > 2 And daisyo < 7 Then
 daisy = "■□□□"
ElseIf daisyo > 6 And daisyo < 11 Then
 daisy = "■■■□"
ElseIf daisyo > 10 Then
 daisy = "■■□□"
End If
 Cells(gyou, 79) = daisy
'daisyo間隔
End Sub
--------------------------------------------------------------------------
Sub hotno_copy()
gocel = Cells(1, 2) + 10
Sheets("パターン表").Select
Range("R2:U5000").Select
Selection.Copy
Sheets("欠け算並び").Select
Range("eh10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Cells(gocel, 138).Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub stpear_suji()   'ペアストレート数字千百、千十、千一,百十、百一、十一に別に回号、間隔、番号を出力。
Dim j As long, k As long, i As long, n As long, caunter As long, maxx As long
Dim setretu As long, span As long, writretu As long

 Sheets("23桁").Select
 kaigo = Cells(1, 5)
Call saikeisanoff '再計算を止めて計算を速くする・
caunter = 0
  Range("BXL4:EAE5000").Select '出力表示部のクリア
Selection.ClearContents
Application.ScreenUpdating = False '画面変更をしない。
i = 4
Do Until Cells(i, 1892) = "" And Cells(i, 1897) = ""
For n = 1 To 6 '千百、千十、千一,百十、百一、十一に分ける。
setretu = Cells(i, 1892 + n).Value '番号によりデータ記入位置を設定する。
  Select Case n '千百、千十、千一,百十,百一,十一のデータ表示列位置の設定
  Case 1: span = 1988 '千百
  Case 2: span = 2113 '千十
  Case 3: span = 2238 '千一
  Case 4: span = 2363 '百十
  Case 5: span = 2488 '百一
  Case 6: span = 2613 '十一
End Select
writretu = setretu + span
caunter = Application.CountA(Range(Cells(4, writretu), Cells(70, writretu)))    '記入位   置をカウンタから計算する。
  Cells(4 + caunter, writretu) = Cells(i, 15)    '番号データを4行から記入する。
Cells(100 + caunter, writretu) = Cells(i, 1899)   '回号データを記入する。
Cells(1, writretu) = kaigo - Cells(i, 1899)
If caunter = 0 Then '回号データの間隔を200行から記入する
   Cells(200 + caunter, writretu) = Cells(i, 1899)
Else
   Cells(200 + caunter, writretu) = Abs(Cells(99 + caunter, writretu) - Cells(100 + caunter, writretu))
End If
Cells(2, writretu) = caunter + 1   '合計カウンタを計算し2行目に表示する
  Cells(2, span - 1) = Application.Max(Range(Cells(2, span), Cells(2, span + 100)))
 Next n
    i = i + 1
    If i = 5000 Then Exit Do
Loop
Application.ScreenUpdating = True '画面変更。
Call saikeisanon '再計算を起動させる
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub TKGM4_seiretu()   'stpear_sujiの番号,回号、間隔を下並び出力。
Dim degen_max As long, motosuu As long
Dim i As long, n As long, start As long
If Cells(4, 1988) = "" Then End
start = MsgBox("整列開始しますか？", vbYesNo)
   If start = vbNo Then End
   Sheets("23桁").Select
Application.ScreenUpdating = False '画面変更をしない。
Call saikeisanoff '再計算を止めて計算を速くする・
For n = 1 To 6 '千百、千十、千一,百十、百一、十一に分ける。

      Select Case n '千百、千十、千一,百十,百一,十一のデータ表示列位置の設定
  Case 1: span = 1988 '千百
  Case 2: span = 2113 '千十
  Case 3: span = 2238 '千一
  Case 4: span = 2363 '百十
  Case 5: span = 2488 '百一
  Case 6: span = 2613 '十一
End Select
motosuu = 0
For i = 0 To 99
degen_max = Cells(2, span - 1)
motosuu = Cells(2, i + span)
    Range(Cells(4, i + span), Cells(222 + motosuu, i + span)).Select '番号,
Selection.Cut
Cells(4 + degen_max - motosuu, i + span).Select
ActiveSheet.Paste
Next i
Next n
Call saikeisanon '再計算を起動させる
Application.ScreenUpdating = True '画面変更on。
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー

ナンバーズ4の出目集計（5098回） 
Sub 出目集計() '最終回から10回～1000回分を遡って集計
Dim lastkai As long
Dim s As Range
saikeisanoff
Worksheets("順位裏復活").Select
  lastkai = Cells(1, 113) + 1 '最終回
Set s = Worksheets("パターン表")
For i = 0 To 9　’出目0～9迄
’シート順位裏復活の7行目の115列から124列までに
’シートパターン表の最終回から10回分を出目毎に集計する。
   Cells(7, 115 + i) = Application.CountIf(s. _
Range(s.Cells(lastkai - 9, 18), s.Cells(lastkai, 21)), i) '10回分
   For j = 1 To 4　’4桁分
Cells(j + 9, 115 + i) = Application.CountIf(s. _
Range(s.Cells(lastkai - 29, 17 + j), s.Cells(lastkai, 17 + j)), i) '30回分
Cells(j + 16, 115 + i) = Application.CountIf(s. _
Range(s.Cells(lastkai - 49, 17 + j), s.Cells(lastkai, 17 + j)), i) '50回分              
Cells(j + 23, 115 + i) = Application.CountIf(s. _
Range(s.Cells(lastkai - 99, 17 + j), s.Cells(lastkai, 17 + j)), i) '100回分
Cells(j + 30, 115 + i) = Application.CountIf(s. _
Range(s.Cells(lastkai - 199, 17 + j), s.Cells(lastkai, 17 + j)), i) '200回分
Cells(j + 37, 115 + i) = Application.CountIf(s. _
Range(s.Cells(lastkai - 499, 17 + j), s.Cells(lastkai, 17 + j)), i) '500回分
  Cells(j + 44, 115 + i) = Application.CountIf(s. _
Range(s.Cells(lastkai - 999, 17 + j), s.Cells(lastkai, 17 + j)), i) '1000回分
Next j
Next i
Range("DK2:DT6").Select
saikeisanon
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
 Sub box_move() 'box間移動
Dim i As long, k As long, gyou As long, gyounext As long, nextgyou As long
Dim boxspan As long
Worksheets("パターン表").Select
  gyou = ActiveCell.Row
  boxspan = Cells(gyou, 83)
  If ActiveCell.Column <> 83 Then End
If Cells(gyou, 84) = 1 Then End
   nextgyou = Application.CountIf(Range(Cells(gyou, 83), Cells(gyou - 200, 83)), boxspan)
If nextgyou = 1 Then
gyou = gyou - 200
Else
gyou = gyou - 1
End If
  i = 1
Do Until boxspan = Cells(gyou - i, 83)
i = i + 1
Cells(gyou - i, 83).Select
If ActiveCell.Row = 3 Then Exit Do
Loop
Application.ScreenUpdating = True '画面変更。
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー

Sub rl_lin_edrow() '右下に線を引く(目視でスライド確認して)
Dim retu_frg As long
    retu = ActiveCell.Column
   gyou = ActiveCell.Row 
  With Selection.Borders(xlDiagonalDown)
       .LineStyle = xlDot
       .Color = -16738048
       .TintAndShade = 0
       .Weight = xlThin
   End With  
   If Cells(gyou + 1, retu + 1) <> "" Then
     If retu > 75 Then retu = 67: Cells(gyou + 1, retu).Select: End
     Cells(gyou + 1, retu + 1).Select  
     rl_lin_edrow  
  End If 
     If retu >= 56 And retu <= 65 Then retu_frg = 1
     If retu >= 67 And retu <= 75 Then retu_frg = 2
     If retu_frg <> 0 Then Cells(gyou + 1, retu + 1).Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーー
Sub lr_line_drow()
’左下に線を引く(目視でスライド確認して)
    retu = ActiveCell.Column
   gyou = ActiveCell.Row  
  If retu <= 55 Or retu >= 77 Or retu = 66 Then End  
   If retu >= 67 And retu <= 76 Then retu_f = 1
   If retu >= 56 And retu <= 65 Then retu_f = 2  
   With Selection.Borders(xlDiagonalUp)
       .LineStyle = xlDot
       .Color = -16738048
       .TintAndShade = 0
       .Weight = xlThin
   End With  
  If Cells(gyou + 1, retu - 1) <> "" Then 
    If retu_f = 1 Then
     If retu = 67 Then retu = 76: Cells(gyou + 1, retu).Select: End
   ElseIf retu_f = 2 Then
    If retu = 56 Then retu = 65: Cells(gyou + 1, retu).Select: End 
   End If
    Cells(gyou + 1, retu - 1).Select  
    lr_line_drow  
  End If
      Cells(gyou + 1, retu - 1).Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub rk_lin_edrow() '強弱順位で右下に線を引く
Dim retu_frg As long
    retu = ActiveCell.Column
   gyou = ActiveCell.Row
   With Selection.Borders(xlDiagonalDown)
       .LineStyle = xlDot
       .Color = -16738048
       .TintAndShade = 0
       .Weight = xlThin
   End With  
   If Cells(gyou + 1, retu + 1) <> "" Then
      If retu > 64 Then retu = 56: Cells(gyou + 1, retu).Select: End
      Cells(gyou + 1, retu + 1).Select  
     rk_lin_edrow  
  End If 
    If retu >= 56 And retu <= 65 Then retu_frg = 1
    If retu >= 67 And retu <= 75 Then retu_frg = 2
    If retu_frg <> 0 Then Cells(gyou + 1, retu + 1).Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーー
Sub lk_line_drow()
’強弱順位で左下に線を引く
 retu = ActiveCell.Column
   gyou = ActiveCell.Row
   With Selection.Borders(xlDiagonalUp)
       .LineStyle = xlDot
       .Color = -16738048
       .TintAndShade = 0
       .Weight = xlThin
   End With  
  If Cells(gyou + 1, retu - 1) <> "" Then
    If retu = 56 Then retu = 65: Cells(gyou + 1, retu).Select: End
    Cells(gyou + 1, retu - 1).Select  
         lk_line_drow  
    End If
      Cells(gyou + 1, retu - 1).Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub hotnum_color()
 Dim maruiti As Range
 Dim gyou As long, retu As long, yiti As long
 Dim demebar As Object, ndemebar As Object
Dim  tdemebar As Object, demerenbar As Object

Worksheets("パターン表").Select
Application.ScreenUpdating = False '画面変更をしない。
   gyou = ActiveCell.Row
   retu = ActiveCell.Column
   If retu <= 17 Or retu >= 22 Then End 
　deme__iti = Cells(gyou, retu) + 67
   deme = Cells(gyou, retu) '出目
If Cells(gyou, retu) > 4 Then
   With Selection.Interior     
       .Color = 65535    
   End With
Else
     With Selection.Interior   
       .Color = 10092543   
   End With  
End If
  Set maruiti = Application.Cells(gyou, deme__iti)  
   maruiti.Font.Underline = xlUnderlineStyleSingle
   maruiti.Font.ColorIndex = 53  
  yiti = deme - Cells(gyou, 85) '出目の位置
Cells(gyou + yiti, retu + 70).Select '桁別に88行から出目対応して上下に
    With Selection.Interior
       .Color = 10092543
    End With   
    Sheets("欠け算並び").Cells(gyou + 8, retu + 125) = Worksheets("パターン表").Cells(gyou, retu)
    Worksheets("パターン表").Select   
    Application.ScreenUpdating = True '画面変更をしない。
    Cells(gyou + 1, retu).Select
 End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub box_pear_total_kai()   'ペア数字集計
Dim xx As long, ii As long, i As long, kai As long, owari As long
Sheets("23桁").Select
Call all_hyouji
i = 4
Range("ace4:aeh6334").Select
Selection.ClearContents
Cells(3, 759) = Empty
 kai = Application.InputBox("集計間隔を入力して下さい", Default:=9)
 start = MsgBox("開始しますか？", vbYesNo)
If start = vbNo Then End
    Sheets("23桁").Select
    Cells(3, 759) = kai
 Call saikeisanoff
    owari = Cells(1, 1) + kai
For xx = 0 To 54
 For ii = 0 To owari Step kai
  Cells(i, 760 + xx) = Application.CountA(Range(Cells(4 + ii, 681 + xx), Cells(ii + kai + 3, 681 + xx)))
  If ii > 0 Then Cells(i - 1, 759) = ii
 i = i + 1
 Next ii
     i = 4
Next xx
Call saikeisanon
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub all_hyouji()
Columns("BXL:BZL").Select
Selection.EntireColumn.Hidden = False
End Sub
Sub all_hyouji_kai()
Columns("acg:aeh").Select
Selection.EntireColumn.Hidden = False
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー

Sub rencunters() '連荘パターン集計
    retu = ActiveCell.Column
    gyou = ActiveCell.Row
  Call saikeisanoff
    i = 0
  Do Until Cells(gyou + i, retu) = ""
      If Cells(gyou + i, retu) <> 0 Then
              Cells(gyou + i, retu + 1) = k + 1
              k = k + 1
          If Cells(gyou + i + 1, retu) = 0 Then
             rentyan = k: k = 0
             Cells(gyou + i, retu + 2) = rentyan '連荘合計
          End If
     End If
    If i = 6000 Then Exit Do
       i = i + 1  
 Loop
        If i = 0 Then MsgBox "ﾃﾞｰﾀ等をﾁｪｯｸして下さい。": End
    Call saikeisanon
  End Sub
______________________________________________________________________
記事目次　ナンバーズ4