hiro さん:

こんにちは。

以下に添削を返送します。参考にしてください。

> コメント欄を拝見し、
> 他の受講生の方のレベルの高さに大変驚いておりますが、
> 伝票作成の宿題を作成致しましたので、
> ご確認の程宜しくお願い致します。

いえいえ。かなりきれいにマクロを書けていると思います。
ひきつづき、学習お楽しみください☆

Option Explicit
Public Sub CreateDenpyo()
    InputNo
    SortCltName
    CalledCreateDenpyo
    SortNo
End Sub
Private Sub CalledCreateDenpyo()
    'ハンガリアン記法で行くなら、「小文字で型、大文字で意味」というスタイルがおすすめです。
    '例: 以下の要領
    'wsMa: ワークシート「main」の意味
    'wsMa1: ワークシート「main1」の意味
    'wsClt: ワークシートのうち、コントロール対象のものという意味
    'strCltName: 文字列のうち、コントロール対象シートの名前という意味
    DeleteSheets
    Dim gyo As Long
    Dim gyoMx As Long
    Dim cltName As String
    Dim maWs As Worksheet
    Dim ma1Ws As Worksheet
    Dim cltWs As Worksheet
    Dim dt As Date
    Dim toGyo As Long
    
    gyoMx = Range("B" & Rows.Count).End(xlUp).Row
    For gyo = 2 To gyoMx
        Set maWs = Worksheets("main")
        If cltName <> maWs.Range("B" & gyo).Value Then
            If gyo <> 2 Then
                DrawKeisen
            End If
            cltName = maWs.Range("B" & gyo).Value
            Set ma1Ws = Worksheets("main1")
            ma1Ws.Copy after:=Worksheets(Worksheets.Count)
            Set cltWs = ActiveSheet
            cltWs.Name = cltName
            toGyo = 16
        End If
        cltWs.Range("H" & toGyo).Value = maWs.Range("F" & gyo).Value
        cltWs.Range("E" & toGyo).Value = maWs.Range("D" & gyo).Value
        cltWs.Range("F" & toGyo).Value = maWs.Range("E" & gyo).Value
        If maWs.Range("G" & gyo).Value > 0 Then
            cltWs.Range("I" & toGyo).Value = maWs.Range("G" & gyo).Value
        Else
            cltWs.Range("J" & toGyo).Value = maWs.Range("G" & gyo).Value
        End If
        dt = maWs.Range("C" & gyo).Value
        cltWs.Range("B" & toGyo).Value = Right(Year(dt), 2)
        cltWs.Range("C" & toGyo).Value = Month(dt)
        cltWs.Range("D" & toGyo).Value = Day(dt)
        If toGyo = 16 Then
            cltWs.Range("K" & toGyo).Value = maWs.Range("G" & gyo).Value
        Else
            cltWs.Range("K" & toGyo).Value = maWs.Range("G" & gyo).Value + cltWs.Range("K" & toGyo - 1).Value
        End If
        toGyo = toGyo + 1
    Next
    DrawKeisen
    maWs.Activate
End Sub
Public Sub DeleteSheets()
    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
Private Sub DrawKeisen()
    'シンプルかつキレイです (^^*
    Dim gMax As Long
    gMax = Range("B" & Rows.Count).End(xlUp).Row
    With Range("B16:K" & gMax + 1)
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
    End With
End Sub
Private Sub InputNo()
    'autofillを使った書き方も研究してみてください。自動記録しつつautofillして得られたマクロを修正して作ると比較的簡単かと。
    Dim c As Long
    Dim lastGyo As Long
    Worksheets("main").Activate
    Range("A1").Value = "No."
    lastGyo = Range("B" & Rows.Count).End(xlUp).Row
    For c = 2 To lastGyo
        Range("A" & c).Value = c - 1
    Next
End Sub

'SortCltName と SortNo は(ほぼ)並べ替え対象の行が違うだけなので、ひとつにまとめられるかもしれません。
'その場合はモジュールレベル変数を使います。トライしてみてください。
Private Sub SortCltName()
    'データ数に関わらず動くように修正しましょう (^^
    'シンプルかつキレイです (^^*
    With Worksheets("main").Sort.SortFields
        .Clear
        .Add Key:=Range("B2:B317"), _
            SortOn:=xlSortOnValues, _
            Order:=xlAscending, _
            DataOption:=xlSortNormal
    End With
    With Worksheets("main").Sort
        .SetRange Range("A1:G317")
        .Header = xlYes
        .Apply
    End With
End Sub
Private Sub SortNo()
    'データ数に関わらず動くように修正しましょう (^^
    'シンプルかつキレイです (^^*
    With Worksheets("main").Sort.SortFields
        .Clear
        .Add Key:=Range("A2:A317"), _
            SortOn:=xlSortOnValues, _
            Order:=xlAscending, _
            DataOption:=xlSortNormal
    End With
    With Worksheets("main").Sort
        .SetRange Range("A1:G317")
        .Header = xlYes
        .Apply
    End With
    With Worksheets("main")
        .Columns("A").Value = ""
        .Range("A1").Activate
    End With
End Sub

2020/07/20 02:48

小川先生:

お世話になっております。
hiroと申します。

伝票作成宿題の件、
添削頂きありがとうございました。
・変数をハンガリアン記法で記述
・autofillで連番を振る
・変数をモジュールレベル変数にまとめる
・並べ替えの対象がデータ数に関わらず動作するようにする
これらご指摘頂いた内容をもとに、
再度、作成致しましたので
ご確認の程宜しくお願い致します。

2020/07/24 07:32

受講生 さん:

おはようございます。

添削を返送します。
ひきつづき、学習お楽しみください (^^

Option Explicit
Dim sRetsu As String 'これをしてほしかった。
'Dim lngLastGyo As Long 'CalledCreateDenpyo内で宣言している変数と名前がかぶっています。
'混乱をさけるため、この変数を作るにしても、たとえばこちらは lngGLastGyo とかの名称にするのもありです。
'(G は Global、つまりモジュールレベル変数 という意味)
'↑調査を一度だけで済ませられるという意味ではこの変数を各モジュールで使い回すのはありです。
'が、そうすると結合度が高くなる（部品として使い回すのが大変になる等、別の面倒が発生する）ということで、このアイデアは採用しません。
'  （モジュールレベル変数の宣言は、最小限にするのが望ましいです。）
'  今の段階ではちょっと悶々とするところもあるかもしれません。
'が、発展編2で「引数付きプロシージャ」を学習するとこの手の悩みを解決できるようになります。
Public Sub CreateDenpyo2()
    InputNo
    
'    SortCltName
    sRetsu = "B"
    SortMainSheet
    
    DeleteSheets2 'DeleteNumについて述べたのと同様の理由でCalledCreateDenpyoから外に出しました。
    CalledCreateDenpyo

'    SortNo
    sRetsu = "A"
    SortMainSheet

    DeleteNum 'A列への値入力がCreateDenpyo内にあるなら、A列の値削除もCreateDenpyo内にあるほうがよいです。各プロシージャでの作業の粒度を統一すると可読性が増します
End Sub
Private Sub CalledCreateDenpyo()
    'ハンガリアン記法で行くなら、「小文字で型、大文字で意味」というスタイルがおすすめです。
    '例: 以下の要領
    'wsMa: ワークシート「main」の意味
    'wsMa1: ワークシート「main1」の意味
    'wsClt: ワークシートのうち、コントロール対象のものという意味
    'strCltName: 文字列のうち、コントロール対象シートの名前という意味
'    4ets
    Dim lngGyo As Long
    Dim lngGyoMx As Long
    Dim strCltName As String
    Dim wsMa As Worksheet
    Dim wsMa1 As Worksheet
    Dim wsClt As Worksheet
    Dim dt As Date
    Dim lngToGyo As Long
     
    lngGyoMx = Range("B" & Rows.Count).End(xlUp).Row
    For lngGyo = 2 To lngGyoMx
        Set wsMa = Worksheets("main")
        If strCltName <> wsMa.Range("B" & lngGyo).Value Then
            If lngGyo <> 2 Then
                DrawKeisen
            End If
            strCltName = wsMa.Range("B" & lngGyo).Value
            Set wsMa1 = Worksheets("main1")
            wsMa1.Copy after:=Worksheets(Worksheets.Count)
            Set wsClt = ActiveSheet
            wsClt.Name = strCltName
            lngToGyo = 16
        End If
        wsClt.Range("H" & lngToGyo).Value = wsMa.Range("F" & lngGyo).Value
        wsClt.Range("E" & lngToGyo).Value = wsMa.Range("D" & lngGyo).Value
        wsClt.Range("F" & lngToGyo).Value = wsMa.Range("E" & lngGyo).Value
        If wsMa.Range("G" & lngGyo).Value > 0 Then
            wsClt.Range("I" & lngToGyo).Value = wsMa.Range("G" & lngGyo).Value
        Else
            wsClt.Range("J" & lngToGyo).Value = wsMa.Range("G" & lngGyo).Value
        End If
        dt = wsMa.Range("C" & lngGyo).Value
        wsClt.Range("B" & lngToGyo).Value = Right(Year(dt), 2)
        wsClt.Range("C" & lngToGyo).Value = Month(dt)
        wsClt.Range("D" & lngToGyo).Value = Day(dt)
        If lngToGyo = 16 Then
            wsClt.Range("K" & lngToGyo).Value = wsMa.Range("G" & lngGyo).Value
        Else
            wsClt.Range("K" & lngToGyo).Value = wsMa.Range("G" & lngGyo).Value + wsClt.Range("K" & lngToGyo - 1).Value
        End If
        lngToGyo = lngToGyo + 1
    Next
    DrawKeisen
    wsMa.Activate
End Sub
Public Sub DeleteSheets2()
    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
Private Sub DrawKeisen()
    'シンプルかつキレイです (^^*
    Dim lngGMax As Long
    lngGMax = Range("B" & Rows.Count).End(xlUp).Row
    With Range("B16:K" & lngGMax + 1)
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
    End With
End Sub
Private Sub InputNo()
    Dim lngLastGyo As Long
    lngLastGyo = Worksheets("main").Range("B" & Rows.Count).End(xlUp).Row
    
    '↓うまいです。
    Worksheets("main").Activate
    Range("A1").Value = "No."
    lngLastGyo = Range("B" & Rows.Count).End(xlUp).Row
    With Range("A2")
        .Value = 1
        .AutoFill Destination:=Range("A2:A" & lngLastGyo), Type:=xlFillSeries
    End With
End Sub
Private Sub SortMainSheet()
    Dim lngLastGyo As Long
    lngLastGyo = Worksheets("main").Range("B" & Rows.Count).End(xlUp).Row
    With Worksheets("main").Sort
        With .SortFields
            .Clear
            .Add Key:=Range(sRetsu & "2:" & sRetsu & lngLastGyo), _
                SortOn:=xlSortOnValues, _
                Order:=xlAscending, _
                DataOption:=xlSortNormal
        End With
        .SetRange Range("A1:G" & lngLastGyo)
        .Header = xlYes
        .Apply
    End With
End Sub
Private Sub DeleteNum()
    Dim lngLastGyo As Long
    lngLastGyo = Worksheets("main").Range("B" & Rows.Count).End(xlUp).Row
    With Worksheets("main")
        .Activate
        .Columns("A").Value = ""
        .Range("A1").Activate
    End With
End Sub
'Private Sub SortMainSheet()
'    With Worksheets("main").Sort.SortFields
'        .Clear
'        .Add Key:=Range("B2:B" & lngLastGyo), _
'            SortOn:=xlSortOnValues, _
'            Order:=xlAscending, _
'            DataOption:=xlSortNormal
'    End With
'    With Worksheets("main").Sort
'        .SetRange Range("A1:G" & lngLastGyo)
'        .Header = xlYes
'        .Apply
'    End With
'End Sub

'Private Sub SortNo()
'    Dim lngLastGyo As Long
'    lngLastGyo = Worksheets("main").Range("B" & Rows.Count).End(xlUp).Row
'    With Worksheets("main").Sort.SortFields
'        .Clear
'        .Add Key:=Range("A2:A" & lngLastGyo), _
'            SortOn:=xlSortOnValues, _
'            Order:=xlAscending, _
'            DataOption:=xlSortNormal
'    End With
'    With Worksheets("main").Sort
'        .SetRange Range("A1:G" & lngLastGyo)
'        .Header = xlYes
'        .Apply
'    End With
'    With Worksheets("main")
'        .Columns("A").Value = ""
'        .Range("A1").Activate
'    End With
'End Sub
'
''SortCltName と SortNo は(ほぼ)並べ替え対象の行が違うだけなので、ひとつにまとめられるかもしれません。
''その場合はモジュールレベル変数を使います。トライしてみてください。
'Private Sub SortCltName()
'    'データ数に関わらず動くように修正しましょう (^^
'    'シンプルかつキレイです (^^*
'    With Worksheets("main").Sort.SortFields
'        .Clear
'        .Add Key:=Range("B2:B" & lngLastGyo), _
'            SortOn:=xlSortOnValues, _
'            Order:=xlAscending, _
'            DataOption:=xlSortNormal
'    End With
'    With Worksheets("main").Sort
'        .SetRange Range("A1:G" & lngLastGyo)
'        .Header = xlYes
'        .Apply
'    End With
'End Sub

2020/07/24 17:01

小川先生:

お世話になっております。
hiroと申します。

添削頂いてから時間が経過してしまい、
大変申し訳ございませんでした。

ご指摘頂いたモジュールレベル変数で、
列を宣言する方法、大変勉強になりました。
また前回、ナンバーを並べ替えるプロシージャの
最後の部分にナンバーを消す処理を書いておりましたが、
ご指摘頂いたプロシージャを分けることでとても見やすくなったと感じております。

一つお伺いしたいのですが、
最終行を取得する変数をいろいろなプロシージャで宣言してしまいましたが、これらは混同しない用、同じ変数名を使用することは避けた方が宜しいでしょうか。

ご教示の程、宜しくお願い致します。

2020/08/17 08:20

受講生 さん:

お返事ありがとうございます。

>ご指摘頂いたモジュールレベル変数で、
>列を宣言する方法、大変勉強になりました。
>また前回、ナンバーを並べ替えるプロシージャの
>最後の部分にナンバーを消す処理を書いておりましたが、
>ご指摘頂いたプロシージャを分けることでとても見やすくなったと感じております。

「書いてみて、添削を受けて」というのは、上達の近道のひとつですね。


>一つお伺いしたいのですが、
>最終行を取得する変数をいろいろなプロシージャで宣言してしまいましたが、これらは混同しない用、同じ変数名を使用することは避けた方が宜しいでしょうか。
>
>ご教示の程、宜しくお願い致します。

「混同しないように」ということでしたら、別の変数名にするほうが無難です。
ですが、「自分は混同する心配はない」ということでしたら、同一の変数名にしたほうが良いかと思います。


以下に補足します。

まず、原則を書くと:
[1] プロシージャ内でしか利用しない変数については、他のプロシージャ内で宣言する場合も同一の名称でかまいません。
[2] 一方、同一の目的で利用する変数だからといって、「モジュールレベル変数をひとつ宣言して使い回す」というのは好ましくありません。

というところです。
上記については十分にご理解いただいているという前提で、回答します。
[1]のとおりなので、同じ変数名を使用することには問題ありません。というか、慣れてきたら、むしろそのほうが良いかと思います。
たとえば、「表の最終行の行番号を格納する変数はいつも cMx とする」等のパターンを作ってしまったほうが、生産性はあがります。

講座内で、あるいは演習で、僕が極力（たとえ別プロシージャに宣言する変数であっても）違う名前にしようとしているのは、（特に、導入編-基礎編初期のレベルの方ですと）「どこで宣言したどの変数がどこまでどう効いているのか？」ということを把握する力が未熟なため、「同一名の変数をあちこちで宣言していると、それだけで講座受講中に頭がクラクラして挫折してしまう」というケースがまま見られたからです。
（これは、その方のもともとの記号認知能力の問題でなく、慣れの問題です。僕自身、python等の別言語を学習するとき、初期には、サンプルコード内で同一名の変数やあるいは文字列が様々な箇所で登場するコードを読み解くにはかなり苦労しました）

ということで...。
再度結論を書くと、

・「混同しないように」ということでしたら、別の変数名にするほうが無難
・「自分は混同する心配はない」ということでしたら、同一の変数名にしたほうが良い

というところです。

2020/08/17 21:23