投稿/コメントを表示します。

発展編1 フォローメールセミナー
発展編1 フォローメールセミナー　第11回

凜さんの投稿

(投稿ID: 5501)

お世話になっております。
宿題の提出をさせて頂きます。
ここまでの丁寧なご説明のおかげで作成の流れやそれぞれのマクロの書き方はある程度理解できた為、今回は以前の授業で教えて頂いた「サブプロシージャの分割と呼び出し」「モジュールレベル変数」へのチャレンジもしてみました。
その中でふと疑問に思ったのですが、「モジュールレベル変数」でOption Explicitの直後に変数を宣言し、変数の中身は各プロシージャごとに記載したのですが、「一度、設定した変数の値は再設定されるまで複数のプロシージャ間で有効になる」という事は1番上のプロシージャですべての変数の値を記載しておくという書き方もいいのでしょうか。
今後、仕事で使っていく上で書き方としての良し悪しも合わせて教えていただけますでしょうか。

下記、添削をお願いします。
Option Explicit
Dim Main As Worksheet
Dim main1 As Worksheet
Dim Gyo As Long
Dim Retsu As String
Dim Ws As Worksheet
Dim Tenki As Long
Dim Saigo As Long

Private Sub S_Denpyo()
    S_ANo                                           'メインのA列に連番を振る
    
    Retsu = "B"                                    '並べ替えのキー指定
    S_Narabekae                                '社名で並べ替える
    
    S_sakujyo                                       'シートが重複しないように既に作成されている伝票を削除する
    
    S_sakusei                                       '伝票作成
    
    Retsu = "A"                                     '並べ替えのキー指定
    S_Narabekae                                '番号で並べ替える
    
    Saigo = Main.Range("B" & Main.Rows.Count).End(xlUp).Row　'最終行の設定
    Main.Range("A1:A" & Saigo).Clear                　　　　　　　　　   'A列の値を消す

End Sub
Private Sub S_ANo()
    Set Main = Worksheets("main")
    Saigo = Main.Range("B" & Main.Rows.Count).End(xlUp).Row
    
    Main.Range("A1").Value = "No."                  'A列の項目名
    For Gyo = 2 To Saigo                           　　　 'A列に連番を振る
            Main.Range("A" & Gyo).Value = Gyo - 1
    Next
End Sub
Private Sub S_Narabekae()                         　   'mainの並べ替え
    Set Main = Worksheets("main")
    Saigo = Main.Range("B" & Main.Rows.Count).End(xlUp).Row

    Main.Range("A2:G" & Saigo).Sort _
        Key1:=Main.Range(Retsu & 1), _
        Order1:=xlAscending, _
        Header:=xlNo
End Sub

Private Sub S_sakusei()
    Set Main = Worksheets("main")
    Set main1 = Worksheets("main1")
    Tenki = 16
    Saigo = Main.Range("B" & Main.Rows.Count).End(xlUp).Row

    
    For Gyo = 2 To Saigo
        If Main.Range("B" & Gyo).Value <> Main.Range("B" & Gyo - 1).Value Then 
         　　　　　　　　　　　　　　　　　　　　　　　　　　　　  '社名の1行目だったら↓
        
            If Left(ActiveSheet.Name, 4) <> "main" Then                                   '罫線を引く
                With Range("B16:K" & Tenki - 1)
                    .Select
                    .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    .Borders(xlEdgeTop).LineStyle = xlContinuous
                    .Borders(xlEdgeBottom).LineStyle = xlContinuous
                    .Borders(xlEdgeRight).LineStyle = xlContinuous
                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                End With
                With ActiveSheet.PageSetup                                            　　　　    'ヘッダー・フッターの設定
                    .LeftHeader = "&A"
                    .RightHeader = "&D"
                    .RightFooter = "&P/&N"
                    .PrintArea = "B2:K" & Tenki                                    　　　　　        '印刷範囲設定
                    .PrintTitleRows = "$14:$15"
                    .Orientation = xlPortrait
                End With
                ActiveSheet.Range("A1").Select
            End If
        
            Tenki = 16
            main1.Copy After:=Worksheets(Worksheets.Count)                           'main1をコピー
            With ActiveSheet
                .Name = Main.Range("B" & Gyo).Value                                      　　　'シート名を変更
                .Range("B" & Tenki).Value = Right(Year(Main.Range("C" & Gyo).Value), 2)   '各項目転記↓
                .Range("C" & Tenki).Value = Month(Year(Main.Range("C" & Gyo).Value))
                .Range("D" & Tenki).Value = Day(Year(Main.Range("C" & Gyo).Value))
                .Range("E" & Tenki).Value = Main.Range("D" & Gyo).Value
                .Range("F" & Tenki).Value = Main.Range("E" & Gyo).Value
                .Range("H" & Tenki).Value = Main.Range("F" & Gyo).Value
                If Main.Range("G" & Gyo).Value > 0 Then
                    .Range("I" & Tenki).Value = Main.Range("G" & Gyo).Value
                Else
                    .Range("J" & Tenki).Value = Main.Range("G" & Gyo).Value
                End If
                .Range("K" & Tenki).Value = Main.Range("G" & Gyo).Value            '元データ1行目のみ計算なし
            End With                                                                    　　　　　　　　　　 '転記ここまで
            Tenki = Tenki + 1
        Else                                                                            　　　　　　　　　　　 '2行目以降の社名だったら↓
            
            With ActiveSheet
                .Range("B" & Tenki).Value = Right(Year(Main.Range("C" & Gyo).Value), 2)  '各項目転記↓
                .Range("C" & Tenki).Value = Month(Year(Main.Range("C" & Gyo).Value))
                .Range("D" & Tenki).Value = Day(Year(Main.Range("C" & Gyo).Value))
                .Range("E" & Tenki).Value = Main.Range("D" & Gyo).Value
                .Range("F" & Tenki).Value = Main.Range("E" & Gyo).Value
                .Range("H" & Tenki).Value = Main.Range("F" & Gyo).Value
                If Main.Range("G" & Gyo).Value > 0 Then
                    .Range("I" & Tenki).Value = Main.Range("G" & Gyo).Value
                Else
                    .Range("J" & Tenki).Value = Main.Range("G" & Gyo).Value
                End If
                If .Range("J" & Tenki).Value = "" Then                                    　　　'借方、貸方から残高計算
                    .Range("K" & Tenki).Value = .Range("K" & Tenki - 1).Value + .Range("I" & Tenki).Value
                Else
                    .Range("K" & Tenki).Value = .Range("K" & Tenki - 1).Value + .Range("J" & Tenki).Value
                End If
            End With                                                                      　　　　　　　　　 '転記ここまで
            Tenki = Tenki + 1
        End If
    Next
    
    With Range("B16:K" & Tenki - 1)                                                         　　　　'最後のシートに罫線をひく
        .Select
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End With
    ActiveSheet.Range("A1").Select
    
    Main.Select
End Sub

Private Sub S_sakujyo()
    For Each Ws In Worksheets
        If Left(Ws.Name, 4) <> "main" Then
            Application.DisplayAlerts = False
            Ws.Delete
            Application.DisplayAlerts = True
        End If
    Next
End Sub

最終的に動くものが出来たのですが、お手本の中でActivesheetを変数に入れていたので、下記のように変数を作成しやってみたのですが、これだけでまったく違う動作をしてしまい断念しました。
違う動作というのはコピー元の「main」シートが「愛知製本」になり、以降230枚ほどのシートが「main」のコピーとして作成されるというものです。
変数以外は変えていない事を確認しつつ、試行錯誤しましたが理解できず、諦めました。
何がいけなかったのでしょうか？
　Dim Acts As Worksheet
　Set Acts = Activesheet

今回、自力でチャレンジする機会を頂いたおかげで今後の自分の仕事への活かし方が具体的に見えてきた気がします。構文は使えるようになったけど自分の仕事としてどこで使えるんだろうという疑問が払拭された感じです。
大変でしたが、とても楽しくできました。ありがとうございました。
これからもよろしくお願いします。
2023/08/26 00:14