ムラゴン ホーム
マクロ学習法とは 4 （仕組作り）
マクロはアイデア？
マクロを覚えようとして、その前に理解出来なければ覚えられないと言う人がいると思います。でも私の経験で言えば理解するのは困難な気がします。
マクロ学習法とは 3 （専門用語）
（ただ単に、マイクロソフトでマクロでの決め事を作っただけですから？）
習うより慣れろ、理解するより覚えろがマクロを学ぶ上で大切な事だと思います。
それと同時に「仕組みを作る」と言うことが凄く大事な気がします。
仕組を作るとは何なのか？
面倒なことはしたくない！
一言で言えばアイデアを考えて行くことだと思います。その為に良く考える。
処理を問題なくするには？どんな処理があってどんな順序でするとか？
自分が望む結果を得るための処理ステップをハッキリさせておきます。
赤に緑の書式コピーする場合、緑を手動選択後 「書式コピー」 マクロ実行をしています。（ツールマクロですが syosikicopy）
でも赤から緑まですごく離れていたら緑に行くのが面倒ですね！
仕組を考えたなら
赤選択後マクロ実行で良いですね！（マクロ syosikicopy2）
楽に処理出来る様に考える事が仕組作りだと思います。
仕組も論理的に考え矛盾が出ないようにすることが前提になりますね。
もっと複雑なら、自分が望む答えが出るように、答えを導き出す関係を全部パターン化してマクロを作るのが良いと思います。（成立条件や制約条件かも知りませんが？）
上手くマクロが出来ない、動かないのは仕組が間違っていることが多いです。
一歩づつ段階を踏んで、マクロを作って行くのが大事だと思います。
変数 知らなかった本当の使い方
Sub syosikicopy() '下に向かい書式コピー 緑の書式を赤にコピーする。
Dim gyou As long, retu As long, i As long
gyou = ActiveCell.Row
retu = ActiveCell.Column
Selection.Copy
i = 1
If Cells(gyou + i, retu) <> "" Then '次行にデータある場合
Cells(gyou + i, retu).Select
Else '次行にデータない場合
Do Until Cells(gyou + i, retu) <> ""
i = i + 1
Cells(gyou + i, retu).Select
If i > 30 Then Exit Do
Loop
End If
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
--------------------------------------------------------------------------------
Sub syosikicopy2() ' syosikicopyのマクロを使いやすくした
Dim gyou As long, retu As long, i As long
gyou = ActiveCell.Row
retu = ActiveCell.Column
i = 1
Do Until Cells(gyou - i, retu) <> ""
i = i + 1
Cells(gyou - i, retu).Select
If i < -30 Then Exit Do
Loop
Cells(gyou - i, retu).Select
Selection.Copy
Cells(gyou, retu).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
良く考えたなら、まだまだ改善の余地が有りそうです。手入力は時間が掛かる上にミスの原因になります。マクロでミスはマクロ作成ミスで手入力より少ないような気がします。
（今は数字の自動入力等を追加しました。）
たとえば4994回に0248のどれかの出目が出たら●を赤色にする。
間隔を入れる。（0が出なかったら●を2にする）
これらをマクロで処理する。
マクロ ptn_haritukeは失敗に マクロ ptn_harituke2に改造
Sub ptn_harituke() '飛び間隔用での出目を表示する
Dim gyou As long, i As long, c_frg As long
Dim deme(4) As long, ima As Variant, mae As Variant
Sheets("box飛").Select
For i = 0 To 9
Cells(1, 16 + i) = i
Next i
On Error GoTo Erachek 'とりあえずエラーで逃げる
gyou = ActiveCell.Row
For i = 1 To 4
deme(i) = Cells(1, 10 + i) '当選番号の出目をｽﾄﾚｰﾄ順に格納
c_frg = Cells(gyou + 1, 16 + deme(i)) '当選出目の下にフラグを立てる。
If c_frg = 0 And Cells(gyou, 16 + deme(i)) = "●" Or c_frg = 0 And Cells(gyou, 16 + deme(i)) = "◎" Then
Cells(gyou, 16 + deme(i)).Font.Color = -16776961
Cells(gyou + 1, 16 + deme(i)) = 1
Else
Cells(gyou, 16 + deme(i)) = "●"
Cells(gyou, 16 + deme(i)).Font.Color = xlThemeColorLight1
Cells(gyou + 1, 16 + deme(i)) = 1
End If
Next i
For j = 0 To 9
If Cells(gyou + 1, 16 + j) = 0 Then
mae = Cells(gyou - 1, 16 + j) '前行の値入れるns mae
ima = Cells(gyou, 16 + j) '今行の値いれる ms ima
If ima = "●" Or ima = "◎" Then
If mae >= 0 Then
Cells(gyou, 16 + j) = mae + 1
Else
If mae = "●" Or mae = "◎" Then
If ima = "●" Or ima = "◎" Then Cells(gyou, 16 + j) = 1
End If
End If
End If
End If
Next j
Erachek:
Exit Sub
End Sub
---------------------------------------------------------
上のマクロ ptn_haritukeは考え方がまとまらずに上手く行かず。
ひとつづつ処理をして段階的に考えて下のマクロ ptn_harituke2に改造
（色んな条件を一度に実行しても上手く行かなかった----ミスの原因に成っていたｗ）
作ったマクロを使って行くうちに、色んな不便な面が分かって来たら仕組作りを見直す時ですね。この辺はマクロを作って直ぐには分からないので、完全なマクロは不便な面を改良して出来るのかも知れません。
Sub ptn_harituke2() '飛び間隔用での出目を表示する 改造 If IsNumeric(Cells(i, 1).Value) = True Then ～ IsNumericで数字か文字を判断
Dim gyou, i, ii, deme(4) As Integer
Sheets("box飛").Select
For i = 0 To 9
Cells(1, 16 + i) = i
Next i
On Error GoTo Erachek 'とりあえずエラーで逃げる
gyou = ActiveCell.Row
For i = 1 To 4
deme(i) = Cells(1, 10 + i) '当選番号の出目をｽﾄﾚｰﾄ順に格納
If Cells(gyou + 1, 16 + deme(i)) = 0 Then
Cells(gyou + 1, 16 + deme(i)) = 1 'シングルの時 1
Else
Cells(gyou + 1, 16 + deme(i)) = Cells(gyou + 1, 16 + deme(i)) + 1 'ダブル以上2以上
End If
Next i
For ii = 0 To 9
If Cells(gyou + 1, 16 + ii) = "" Then
If IsNumeric(Cells(gyou, 16 + ii).Value) = False Then Cells(gyou, 16 + ii) = 1
If IsNumeric(Cells(gyou - 1, 16 + ii).Value) = True Then Cells(gyou, 16 + ii) = Cells (gyou - 1, 16 + ii) + 1
ElseIf Cells(gyou + 1, 16 + ii) = 1 Then
If IsNumeric(Cells(gyou, 16 + ii).Value) = False Then
Cells(gyou, 16 + ii).Select
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
End If
Cells(gyou, 16 + ii) = "●"
ElseIf Cells(gyou + 1, 16 + ii) >= 2 Then
If IsNumeric(Cells(gyou, 16 + ii).Value) = False Then
Cells(gyou, 16 + ii).Select
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
End If
Cells(gyou, 16 + ii) = "◎"
End If
Next ii
Erachek:
Exit Sub
End Sub