小川様

お世話になります。
ファイルをメールで再送したのですが、行き違いだったようですので改めて質問感想フォームから送らせていただきます。

確かに作成に2時間しかかからなかったのは、自分でも驚きですが
ハナコのステップを徹底しただけなんです。
「まずちゃんと動く（団子にあたる）コードを1行書く」ところから始まるこのステップは、私のような初心者には黄金律なようなものです。
マクロを組むときに迷いがない。
それがこれだけ短時間に書き上げられた要因なのかもしれません。

提出させていただいたプログラムは
一見セミナーのそのままなぞったような書き方です。
ですが今回はなぞることを目的にプログラムを組みました。
変数の名前も普段なら
基礎編で学んだ「gyo…」や
ハンガリアン記法を使って「cGyo…」のように使うのですが
できるだけ短い変数を使えるようにしたかったので
メールセミナーのように
InFM/InFmMxを使ってみたりしています。
マクロを初めてまだ3か月もたっておらず知識がないため
引き出しを増やしたいと思い、そのようにさせてもらっています。

下記が宿題の回答となります。
コメントをよろしくお願いします。
↓
Option Explicit
Sub DenpyoZentai()

Call SheetSakujo
Call GyoNarabekae
Call createDenpyo

End Sub

Sub SheetSakujo()
Application.DisplayAlerts = False
Dim ws As Worksheet
For Each ws In Worksheets
If Left(ws.Name, 4) <> "main" Then
ws.Delete
End If
Next
Application.DisplayAlerts = True
End Sub
Sub GyoNarabekae()

Dim wsFm As Worksheet
Dim cnt As Long
Dim InFmMx As Long
Set wsFm = Worksheets("main")
InFmMx = Range("B" & Rows.Count).End(xlUp).Row
For cnt = 2 To InFmMx
wsFm.Range("A" & cnt).Value = cnt
Next
wsFm.Range("A1").Value = "日付"
wsFm.Range("A1:G" & InFmMx).Sort Key1:=Range("B1"), _
Order1:=xlAscending, _
Header:=xlYes
End Sub

Sub GyoModosu()

Dim wsFm As Worksheet
Dim InFmMx As Long
Set wsFm = Worksheets("main")
InFmMx = Range("B" & Rows.Count).End(xlUp).Row
wsFm.Range("A1:G" & InFmMx).Sort Key1:=Range("A1"), _
Order1:=xlAscending, _
Header:=xlYes
Range("A1:A" & InFmMx).ClearContents

End Sub

Sub createDenpyo()
Dim wsFm As Worksheet
Dim wsTo As Worksheet
Dim InFm As Long
Dim InFmMx As Long
Dim InTo As Long
Dim dt As Long
Set wsFm = Worksheets("main")
InFmMx = Range("B" & Rows.Count).End(xlUp).Row
For InFm = 2 To InFmMx
If wsFm.Range("B" & InFm).Value <> wsFm.Range("B" & InFm).Offset(-1, 0).Value Then
If InFm > 2 Then
Call Keisen
End If
Worksheets("main1").Copy after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = wsFm.Range("B" & InFm).Value
Set wsTo = ActiveSheet
InTo = 16
End If
dt = wsFm.Range("C" & InFm).Value
wsTo.Range("B" & InTo).Value = Format(dt, "yy")
wsTo.Range("C" & InTo).Value = Format(dt, "m")
wsTo.Range("D" & InTo).Value = Format(dt, "d")
wsTo.Range("E" & InTo).Value = wsFm.Range("D" & InFm).Value
wsTo.Range("F" & InTo).Value = wsFm.Range("E" & InFm).Value
wsTo.Range("H" & InTo).Value = wsFm.Range("F" & InFm).Value
If wsFm.Range("G" & InFm).Value < 0 Then
wsTo.Range("I" & InTo).Value = wsFm.Range("G" & InFm).Value
Else
wsTo.Range("J" & InTo).Value = wsFm.Range("G" & InFm).Value
End If
If InTo = 16 Then
wsTo.Range("K16").Value = wsFm.Range("G2").Value
Else
wsTo.Range("K" & InTo).Value = wsTo.Range("K" & InTo).Offset(-1, 0).Value + wsFm.Range("G2").Value
End If
InTo = InTo + 1
Next InFm
Call Keisen
wsFm.Activate
End Sub

Sub Keisen()
'
Dim InFmMx As Long
InFmMx = Range("B" & Rows.Count).End(xlUp).Row

Range("B16:K" & InFmMx).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.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
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
End Sub

2017/12/11 17:34