趣味のエクセルで当てよう!ロト・ナンバーズ

当選狙いで、ナンバーズ4をメインにロト、ビンゴ5などの各種データリストや、それらの分析用エクセルVBAなどについて書いてます。

4.No.3 分析

変数 知らなかった本当の使い方
ナンバーズ3 の 各属性(5803回) - 趣味のエクセルで当てよう!ロト・ナンバーズ
Sub Copi_propaty()
Dim Maxx As long, gokeimax As long, start As long
start = MsgBox("「データ集計」を「プロパテイ」にコピーしますか?", vbYesNo)
Call saikeisanoff '再計算を止めて計算を速くする
If start = vbNo Then End
Sheets("プロパテイ").Select
Range("C15:AVF96").ClearContents
Sheets("原本").Select
If Cells(15, 205) <> "" Then MsgBox ("整列してからです"): End
Maxx = Cells(1, 196) + 3
gokeimax = Cells(1, 198)
Range(Cells(2300, 204), Cells(2300 + gokeimax, 223)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("プロパテイ").Select
Cells(16, Maxx - gokeimax).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
'-----------------------------------------
Sheets("原本").Select '奇数偶数
kigumax = Cells(1, 239)
Range(Cells(2300, 241), Cells(2300 + kigumax, 248)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("プロパテイ").Select
'Range("C43").Select
Cells(43, Maxx - kigumax).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
'-----------------------------------
Sheets("原本").Select '大小
daisyomax = Cells(1, 259)
Range(Cells(2300, 261), Cells(2300 + daisyomax, 268)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("プロパテイ").Select
Cells(53, Maxx - daisyomax).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
'------------------------------
Sheets("原本").Select
minipmax = Cells(1, 278)
Range(Cells(2300, 280), Cells(2300 + minipmax, 298)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("プロパテイ").Select
Cells(64, Maxx - minipmax).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
'----------------------------
Sheets("原本").Select
minismax = Cells(1, 308)
Range(Cells(2300, 310), Cells(2300 + minismax, 319)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("プロパテイ").Select
Range("c87").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Cells(1, 1) = Sheets("原本").Cells(1, 197)
Sheets("原本").Select
Range("GV5:HO5").Select
Selection.Copy
Sheets("プロパテイ").Select
Range("BCE16").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("原本").Select
Range("IG5:IN5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("プロパテイ").Select
Range("BCE43").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("原本").Select
Range("JA5:JH5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("プロパテイ").Select
Range("BCE53").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("原本").Select
Range("JT5:KL5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("プロパテイ").Select
Range("BCE64").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("原本").Select
Range("KX5:LG5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("プロパテイ").Select
Range("BCE87").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Call saikeisanon '再計算
Range("a3").Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub TKGM_seiretu()   '番号,回号、間隔を下並び出力。
Dim gokei_max As long, kigu_max As long
Dim  daisyo_max As long, mini_pmax As long, mini_smax As long


Dim i As long, ii As long, j As long, jj As long, k As long, start As long
start = MsgBox("整列開始しますか?", vbYesNo)
If start = vbNo Then End
Sheets("原本").Select
Call saikeisanoff '再計算を止めて計算を速くする
gokei_max = Cells(1, 198)
For i = 0 To 27
        motosuu = Cells(7, i + 200)
      If Cells(2300, i + 200) = "" Then End
If gokei_max > motosuu Then
  Range(Cells(10, i + 200), Cells(gokei_max - motosuu + 9, i + 200)).Select
  Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End If
Next i
kigu_max = Cells(1, 239)
For ii = 1 To 8
motosuu = Cells(7, ii + 240)
If kigu_max > motosuu Then
Range(Cells(10, ii + 240), Cells(kigu_max - motosuu + 9, ii + 240)).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End If
Next ii
daisyo_max = Cells(1, 259)
For j = 1 To 8
motosuu = Cells(7, j + 260)
If daisyo_max > motosuu Then
Range(Cells(10, j + 260), Cells(daisyo_max - motosuu + 9, j + 260)).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End If
Next j
mini_pmax = Cells(1, 278)
For jj = 0 To 18
motosuu = Cells(7, jj + 280)
If mini_pmax > motosuu Then
Range(Cells(10, jj + 280), Cells(mini_pmax - motosuu + 9, jj + 280)).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End If
Next jj
mini_smax = Cells(1, 308)
For k = 0 To 9
motosuu = Cells(7, k + 310)
If mini_smax > motosuu Then
Range(Cells(10, k + 310), Cells(mini_smax - motosuu + 9, k + 310)).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End If
Next k
Call saikeisanon '再計算を起動させる
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub HotNo_Seiretu()
Sheets("すとれ-と").Select
start = MsgBox("整列開始しますか?", vbYesNo)
If start = vbNo Then End
Range("ej4:fm1000").Clear
Range("DB2:EE2").Select
Selection.Copy
Range("EJ2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("DB4:EE462").Select
Application.CutCopyMode = False
Selection.Copy
Range("EJ4").Select
ActiveSheet.Paste
gokei_max = Cells(2, 139)
For j = 1 To 30
motosuu = Cells(2, j + 139)
Range(Cells(4, j + 139), Cells(4 + motosuu, j + 139)).Select '番号,
Selection.Cut
Cells(4 + gokei_max - motosuu, j + 139).Select
ActiveSheet.Paste
Next j
Range("EJ4:FM456").Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub next_spac() '次spaceを表示する
Sheets("原本").Select
Range("lp4:ly6000").ClearContents '出力表示部のクリア
Call saikeisanoff '再計算を止めて計算を速くする
i = 3
Do Until Cells(i, 106) = ""
retu_1 = Cells(i, 106).Value + 328
nextotal = Cells(i + 1, 106).Value
caunter = Application.Count(Range(Cells(5, retu_1), Cells(500, retu_1)))
Cells(3, retu_1) = caunter
Cells(caunter + 5, retu_1) = nextotal
i = i + 1
If i = 4001 Then Exit Do
Loop
Call saikeisanon '再計算をオンにする
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub nextspac_seiretu3()  
Dim gokei_max As long
Dim i, As long ii As long, j As long, jj As long, k As long, start As long
start = MsgBox("整列開始しますか?", vbYesNo)
If start = vbNo Then End
Call saikeisanoff '再計算を止めて計算を速くする
gokei_max = Cells(1, 338)
For i = 0 To 9
  motosuu = Cells(3, i + 328)
  Range(Cells(5, i + 328), Cells(5 + motosuu, i + 328)).Select '番号,
  Selection.Cut
   Cells(5 + gokei_max - motosuu, i + 328).Select
  ActiveSheet.Paste
Next i
Call saikeisanon '再計算を起動させる
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub 当選番号表示()
Sheets("原本").Select
lasty = Cells(1, 12) + 3
Range(Cells(3, 157), Cells(lasty, 157)).Select
Selection.Copy
Range("BX3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells(lasty, 15).Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub 入力赤丸()
Dim maruiti As Range
Sheets("すとれ-と").Select
retu = ActiveCell.Column
gyou = ActiveCell.Row
If Cells(gyou, retu) <> "●" Then End
Set maruiti = Application.Cells(gyou, retu)
maruiti.Font.Underline = xlUnderlineStyleSingle
maruiti.Font.Color = -16776961
Cells(gyou + 1, retu).Select
j = 1
If Cells(gyou + j, retu) <> "●" Then
Do Until Cells(gyou + j, retu) = "●"
 If j > 3 Then Exit Do
 j = j + 1
Loop
Cells(gyou + j, retu).Select
End If
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub hotno_sin()
Dim maruiti As Range
Sheets("原本").Select
retu = ActiveCell.Column
gyou = ActiveCell.Row
Set maruiti = Application.Cells(gyou, retu)
maruiti.Font.Underline = xlUnderlineStyleSingle
maruiti.Font.ColorIndex = 53
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub 入力へ()
  actsheet = ActiveSheet.Name
If actsheet = "原本" Then
retu = 12: w = 4: h = 0
ElseIf actsheet = "すとれ-と" Then
retu = 47: w = 3: h = 1
End If
jp = Cells(1, retu) + 3 + h
Cells(jp, w).Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub 原本へ()
Sheets("原本").Select
End Sub


Sub 二桁へ()
Sheets("二桁").Select
Range("c5").Select
End Sub


Sub laster()
jp = Cells(10, 1) + 7
Cells(jp + 4, 3).Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub Hotcopy()
Sheets("原本").Select
Range("E3:G5000").Select
Selection.Copy
Range("FJ3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
jp = Cells(1, 24) + 3
Cells(jp, 166).Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub l_lin_edrow() '右下に斜めに線を引く
'hippari If retu>75 Then retu = 67: Cells(gyou + 1, retu).Select: End
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 > 85 Then retu = 76
Cells(gyou + 1, retu + 1).Select                
l_lin_edrow                
End If
Cells(gyou + 1, retu + 1).Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub r_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 < 78 Then retu = 86: Cells(gyou + 1, retu).Select: End
Cells(gyou + 1, retu - 1).Select
r_line_drow
End If
Cells(gyou + 1, retu - 1).Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub deme_st3間隔() 'deme間隔でアンダーバー引く
Dim i As long, k As long, gyou As long, retu As long
Dim deme As long, ndeme As long, yiti As long
Dim demebar As Object, ndemebar As Object 
Dim  tdemebar As Object, demerenbar As Object
Worksheets("原本").Select
gyou = ActiveCell.Row
retu = ActiveCell.Column
If retu <= 165 Or retu >= 169 Then End
deme = Cells(gyou, retu)
If deme = "" Then End
Set demebar = Application.Cells(gyou, retu)
Set ndemebar = Application.Cells(gyou, retu + 8)
i = 1
Do Until deme = Cells(gyou - i, retu)
i = i + 1
k = i - 1
If i = 2000 Then Exit Do
Loop
If k >= 11 And k <= 29 Then
demebar.Font.Underline = xlUnderlineStyleSingle
ndemebar.Font.Underline = xlUnderlineStyleSingle
ElseIf k >= 30 Then
demebar.Font.Underline = xlUnderlineStyleDouble
ndemebar.Font.Underline = xlUnderlineStyleDouble
Else
demebar.Font.Underline = xlUnderlineStyleNone
ndemebar.Font.Underline = xlUnderlineStyleNone
End If
If k = 0 Then
Cells(gyou, retu + 8) = 0
Else
Cells(gyou, retu + 8) = k
End If
Cells(gyou + 1, retu).Select
'自動で脇の桁に移動
If Cells(gyou + 1, retu) = "" Then
Cells(gyou - 3, retu + 1).Select
End
End If
deme_st3間隔
'return0
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー

  Sub 間隔計算式__置換()   '計算式置換  上の式をコピーした後マクロ実行する。
Dim gyou As long, retu As long
 Worksheets("原本").Select
gyou = ActiveCell.Row
retu = ActiveCell.Column
If retu <> 25  Then End
a_gyou = gyou - 10
b_gyou = gyou - 1
c_gyou = gyou + 9


 Cells(gyou, retu).Select
  ActiveCell.Replace What:=a_gyou, Replacement:=gyou, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    
    ActiveCell.Replace What:=b_gyou, Replacement:=c_gyou, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
   
   Selection.Copy
    Range(Cells(gyou, retu), Cells(gyou + 9, retu)).Select '10行分貼り付け
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
     
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub hanntei_2()
Dim hani As long
Sheets("ミニ出現数 ").Select
saikeisanoff
For i = 1 To 101
h = 1
 Do Until Cells(2 + i, h + 3) = ""
  If h = 1 Then
      hani = Cells(2 + i, h + 3)
  Else
      hani = Cells(2 + i, h + 3) - Cells(2 + i, h + 2)
  End If
  If hani <= 50 Then
      Cells(2 + i, h + 3).Select
      Selection.Font.ColorIndex = 10 '緑4
  ElseIf hani > 50 And hani <= 100 Then
      Cells(2 + i, h + 3).Select
      Selection.Font.ColorIndex = 1 '青53=茶黒1
  ElseIf hani >= 101 And hani <= 300 Then
      Cells(2 + i, h + 3).Select
       Selection.Font.ColorIndex = 3 '赤
  ElseIf hani > 300 Then
      Cells(2 + i, h + 3).Select
      Selection.Font.ColorIndex = 3 '赤
   Selection.Font.Bold = True
   End If
  h = h + 1
  If h = 60 Then Exit Do
 Loop
  h = 0
Next i
  saikeisanon
End Sub
ーーーーーーーーーーーーーーーーーーーーーーー
Sub HOTNO_3iroiti()
gyou = ActiveCell.Row
retu = ActiveCell.Column             
Cells(500, retu + 90).Select
i = 0
Do Until Cells(500 + i, retu + 90) <> ""     
  i = i - 1              
 If i < -500 Then Exit Do
Loop           
Cells(500 + i, retu + 90).Select      
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー                      
Sub HotNo_3Kanakuiti()
Dim kankaku_d As long , kankakukijyunn As long           
gyou = ActiveCell.Row
retu = ActiveCell.Column
kankaku_d = Cells(gyou, retu)               
Cells(85, retu + 91).Select
kankakukijyunn = Cells(19, retu + 91) + 20
If kankaku_d <= 3 Then
Cells(kankakukijyunn, retu + 91).Select
End
End If
i = 0
Do Until Cells(85 + i, retu + 91) = ""     
   i = i + 1        
   If i = 500 Then Exit Do
Loop
Cells(85 + i, retu + 91).Select
start = MsgBox(kankaku_d & " 間隔はok?", vbYesNo)
If start = vbYes Then
  Cells(85 + i, retu + 91) = kankaku_d
  Cells(kankakukijyunn + 1, retu + 91).Select
Else
  End
End If
End Sub               
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー                      
Sub HotNo_3KanakuWriter()
Dim kankaku_d As long 
gyou = ActiveCell.Row
retu = ActiveCell.Column
kankaku_d = Cells(gyou, retu)
Cells(85, retu + 91).Select
If kankaku_d <= 3 Then
h = 0
Do Until Cells(20 + h, retu + 91) = ""
h = h + 1
Cells(19 + h, retu + 91).Select
If h = 50 Then Exit Do
Loop
End
End If
i = 0
Do Until Cells(85 + i, retu + 91) = ""        
  i = i + 1         
 If i = 500 Then Exit Do
Loop
Cells(85 + i, retu + 91).Select
start = MsgBox(kankaku_d & " 間隔はok?", vbYesNo)
If start = vbYes Then
  Cells(85 + i, retu + 91) = kankaku_d
Else
  End
End If
Cells(Cells(5, retu + 91) + 34, retu + 91).Select             
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー                                    
Sub HotNo_3KanakuWriter_moto()
Dim kankaku_d As long       
gyou = ActiveCell.Row
retu = ActiveCell.Column
kankaku_d = Cells(gyou, retu)
Cells(85, retu + 91).Select
i = 0
Do Until Cells(85 + i, retu + 91) = ""  
  i = i + 1            
 If i = 500 Then Exit Do
Loop
If kankaku_d > 3 Then
    Cells(85 + i, retu + 91) = kankaku_d
Else
    Cells(20, retu + 91).Select: End
End If
Cells(85 + i, retu + 91).Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー            

'土日を除いて日付を追加する。最後の日付の下で実行
Sub dayplus3()
Dim gyou As long      
Worksheets("原本").Select ’実行するシートを指定する。
gyou = ActiveCell.Row ’選択行を変数に入れる。
Cells(gyou - 1, 2).Copy Cells(gyou, 2)
Cells(gyou, 2) = Cells(gyou, 2) + 3 ’月曜日の日付を入れる。
’下の処理で火曜日~金曜日を入れる。
Selection.AutoFill Destination:=Range(Cells(gyou, 2), Cells(gyou + 4, 2)), Type:=xlFillDefault
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー