趣味のエクセルマクロ

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

2.No.3 分析

Sub pear_suji()   'ペアストレート数字百十、百一、十一に別に回号、間隔、番号を出力。
Dim j, k, i, Maxx, yretu, loopend As Integer
Worksheets("二桁").Range("a21").Select
kaigo = Worksheets("原本").Cells(1, 12).Value
Sheets("二桁").Select
Cells(18, 2) = kaigo
loopend = kaigo + 50
 Range("r21:ms1000").ClearContents '出力表示部のクリア
Call saikeisanon
Range("n21") = "=CONCATENATE(原本!E3,原本!F3)"
Range("o21") = "=CONCATENATE(原本!E3,原本!G3)"
Range("p21") = "=CONCATENATE(原本!F3,原本!G3)"
Range("n21:p21").Copy Range(Cells(22, 14), Cells(50 + kaigo, 16))
Call saikeisanoff '再計算を止めて計算を速くする
i = 21
yretu = 0
Do Until Cells(i, 14) = ""
Cells(i, 13) = i - 20 '計算の為の回号表示する。
 For n = 1 To 3 '百十、百一、十一に分ける。
   setretu = Cells(i, 13 + n).Value '当選番号によりデータ記入位置を設定する。
       Select Case n '百十、百一、十一のデータ表示列位置の設定
     Case 1: span = 0 '百十
           Case 2: span = 120 '百一
          Case 3: span = 240 '十一
      End Select
yretu = 18 + setretu + span
caunter = Application.CountA(Range(Cells(21, yretu), Cells(120, yretu))) '記入位置をカウンタから計算する。
   Cells(21 + caunter, yretu) = Cells(i, 13) '回号データを記入する。
 If caunter = 0 Then '回号データの間隔を150行から記入する
 Cells(150 + caunter, yretu) = Cells(i, 13)
Else
 Cells(150 + caunter, yretu) = Abs(Cells(20 + caunter, yretu) - Cells(21 + caunter, yretu))
End If
Cells(i, 359) = Cells(i, 16) 'ミニ
Cells(i, 360) = Cells(150 + caunter, yretu) 'ミニ間隔
Cells(250 + caunter, yretu) = Worksheets("原本").Cells(i - 18, 4)  '番号データをを250行から記入する。
  Cells(19, yretu) = caunter + 1 '合計カウンタを計算表示する
If kaigo = Cells(i, 13) Then
For k = 1 To 100 '最終当選間隔計算
Maxx = kaigo - Application.Max(Range(Cells(21, 17 + k + span), Cells(74, 17 + k + span)))
Cells(18, 17 + k + span) = Maxx
Next k
End If
  Next n
i = i + 1
If i = loopend Then Exit Do
Loop
Range("R18:DM19").Select 'まとめてコピーする。自動記録マクロで作成
Selection.Copy
Range("B23").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
   Range("EH18:IC19").Select
Application.CutCopyMode = False
Selection.Copy
Range("F23").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
    Range("IX18:MS19").Select
Application.CutCopyMode = False
Selection.Copy
Range("J23").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
ActiveWindow.ScrollColumn = 13
Range("B20").Select
Call saikeisanon '再計算を起動させる
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub pear_suji_seiretu()   'ペアストレート数字百十、百一、十一に別に回号、間隔、番号を下並びで整列して出力。時間が掛かるw
Dim j, k, i, Maxx, n, nn As Integer
 Sheets("二桁").Select
   Call saikeisanoff '再計算を止めて計算を速くする
 i = 21
For n = 1 To 3 '百十、百一、十一に分ける。
setretu = Cells(i, 13 + n).Value '番号によりデータ記入位置を設定する。
   Select Case n '百十、百一、十一のデータ表示列位置の設定
   Case 1: span = 18 '百十
     Case 2: span = 138 '百一
    Case 3: span = 258 '十一     
End Select
    Maxx = Application.Max(Range(Cells(19, span), Cells(19, span + 100)))
For nn = 0 To 99
  motosuu = Cells(19, nn + span)
  If Cells(19, 18) = "" Then End
If Maxx > motosuu Then
  Range(Cells(21, nn + span), Cells(Maxx - motosuu + 20, nn + span)).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End If
 Next nn
Next n
Range("q21").Select
Call saikeisanon '再計算を起動させる
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub three_keta千百十() 'ストレート順での3桁出現回号表示
saikeisanoff
Range("j28:alu42").Clear
bangoend = Application.CountA(Range("ストレートパターン!$C$4:$C$4000"))
 setretu = 0
i = 28
Do Until Cells(i, 1) = bangoend + 1
   setretu = Cells(i, 2).Value
caunter = Application.Count(Range(Cells(28, 10 + setretu), Cells(42, 10 + setretu)))
  Cells(28 + caunter, 10 + setretu) = Cells(i, 1)
Cells(26, 10 + setretu) = caunter + 1
   i = i + 1
If Cells(i, 1) = bangoend + 1 Then Cells(27, 10 + setretu).Select
If i = 4000 Then Exit Do
Loop
saikeisanon
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー

Sub nmbers3()'クイックピック
Randomize
Range("a1:b10").Select
Selection.ClearContents
count_5 = 0
For i = 1 To 3
    kai = Int(Rnd() * 10)
 Cells(i, 1) = kai
    Range("c1") = "=count(a1:a10)"
Next i
Range("g10:i10") = kai
   Range("A1:A3").Select
Selection.Copy
Range("G10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー

Sub mini_kankaku() 'ミニ、間隔、回号記入、太字にする
     Dim moji As Range
     Dim  gosel As Integer

      gosel = Cells(18, 2).Value
       Range("MW25").Select
      Selection.Copy
      Range(Cells(26, 361), Cells(gosel + 20, 361)).Select
   
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       
     Cells(gosel + 20, 360).Select
      retu = ActiveCell.Column
      gyou = ActiveCell.Row
     Cells(gyou, 358) = gyou - 20
    
     If Cells(gyou, 361) = 1 Then  '記入セルを太字にする
      Set moji = Application.Cells(gyou, 362)
      moji.Font.Bold = True
     Else
      Set moji = Application.Cells(gyou, 363)
        moji.Font.Bold = True
     End If
        
End Sub

ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub 下揃え()
    Range("D2:D6").Select
Selection.Cut
Range("D6").Select
ActiveSheet.Paste
End Sub
---------------------------------------------------------------------------
Sub pear_suuji_3()   'ペア数字
j = 0
i = 21
k = 0
d = 0
Sheets("二桁").Select
patann = 0
Call saikeisanon
Range("ns21:pu5000").ClearContents
kaigo = Worksheets("原本").Cells(1, 12).Value
Range("nm21") = "=LEFT(原本!CO3,2)"
Range("nn21") = "=LEFT(原本!CO3,1)&RIGHT(原本!CO3,1)"
Range("no21") = "=RIGHT(原本!CO3,2)"
Range("nm21:no21").Copy Range(Cells(22, 377), Cells(20 + kaigo, 379))
  Call saikeisanoff
Do Until Cells(i, 377) = ""
    For j = 1 To 3 '出目の入力348
      d = Cells(i, j + 376).Value
If d >= 0 And d <= 9 Then
   k = 1
ElseIf d >= 11 And d <= 19 Then
 k = 0
ElseIf d >= 22 And d <= 29 Then
  k = -2
ElseIf d >= 33 And d <= 39 Then
  k = -5
ElseIf d >= 44 And d <= 49 Then
  k = -9
ElseIf d >= 55 And d <= 59 Then
  k = -14
ElseIf d >= 66 And d <= 69 Then
  k = -20
ElseIf d >= 77 And d <= 79 Then
  k = -27
ElseIf d >= 88 And d <= 89 Then
  k = -35
ElseIf d = 99 Then
k = -44
Else
k = 0
End If
  Cells(i, 382 + k + d) = Cells(i, 376 + j)
Next j
    i = i + 1
    If i = 4001 Then Exit Do
Loop
Call saikeisanon
  Range("ns6").Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub nextnumber()'桁別の次回の番号表示する。
Dim nenum(3) As String
Dim stopnum As Integer
Call saikeisanon
  Sheets("次数字").Select
kaigo = Application.InputBox("開始回号番号入力して下さい")
If kaigo <= 0 Then End
kaigo = kaigo + 11
Range(Cells(kaigo, 6), Cells(kaigo + 2000, 105)).ClearContents '出力表示部のクリア
    With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
stopnum = Cells(10, 1) + 1
Range("e12").Select
Range("b12") = "=原本!E3&原本!E4"
Range("c12") = "=原本!f3&原本!f4"
Range("d12") = "=原本!g3&原本!g4"
Range("e12") = "=原本!d4"
Range("b12:e12").Copy Range(Cells(13, 2), Cells(stopnum + 10, 5))
  Call saikeisanon
    i = kaigo
Call saikeisanoff '再計算を止めて計算を速くする
Do Until Cells(i, 1) = stopnum
For n = 1 To 3 '百十一に分ける。
  setretu = Cells(i, 1 + n).Value '番号によりデータ記入位置を設定する。
  Cells(i, setretu + 6) = Cells(i, 1 + n)
  nenum(n) = Cells(i, 1 + n)
If n = 1 Then
Cells(i, setretu + 6).Select
With Selection.Font
.Color = -16776961
  End With
ElseIf n = 2 Then
Cells(i, setretu + 6).Select
With Selection.Font
.Color = -11489280
  End With
If nenum(n - 1) = nenum(n) Then
With Selection.Interior
.PatternColorIndex = xlAutomatic
.Color = 10092543
End With
End If
Else
Cells(i, setretu + 6).Select
With Selection.Font
.ThemeColor = xlThemeColorAccent6
End With
If nenum(n - 1) = nenum(n) Or nenum(n - 2) = nenum(n) Then
With Selection.Interior
.PatternColorIndex = xlAutomatic
.Color = 10092543
End With
End If
End If
Next n
i = i + 1
If i = stopnum + 10 Then Exit Do
Loop
 Call saikeisanon '再計算をオンにする
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーー