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

受講生さんの投稿

(投稿ID: 4846)  添付ファイルのダウンロード権限がありません

【要確認】添削依頼

小川さん
いつもお世話になっております。

課題が完了したので、添付して送ります。

●下記コード一覧
Option Explicit

Sub main()
No_Create
Torihiki_Ascending_Order
Denpyo_Create
No_Ascending_Order
No_Reset
End Sub

'伝票作成
Sub Denpyo_Create()
Depyo_Delete
Dim WkFm As Worksheet
Dim WkTo As Worksheet
Dim CFm As Long
Dim CFmMax As Long
Dim CTo As Long
Dim DFm As Date
Dim CSum As Long
Dim SName As String

Set WkFm = Worksheets("main")
CFmMax = WkFm.Range("B65536").End(xlUp).Row

For CFm = 2 To CFmMax
    If SName <> WkFm.Range("B" & CFm).Value Then
        '取引先毎にsheetを作成
        CTo = 16
        SName = WkFm.Range("B" & CFm).Value
        Sheets("main1").Copy After:=Sheets(2)
        Sheets("main1 (2)").Name = SName
        Set WkTo = ActiveSheet
    End If
   
   '会計番号、信憑番号を新規作成したsheetへ転記
   WkTo.Range("E" & CTo).Value = WkFm.Range("D" & CFm).Value
   WkTo.Range("F" & CTo).Value = WkFm.Range("E" & CFm).Value
   
   '新規作成したsheetへ取引金額を転記
   CSum = WkFm.Range("G" & CFm).Value
   If CSum > 0 Then
        WkTo.Range("I" & CTo).Value = CSum
   Else
        WkTo.Range("J" & CTo).Value = CSum
   End If
   
   '新規作成したsheetへ西暦、何月、何日を転記
    DFm = WkFm.Range("C" & CFm).Value
    WkTo.Range("B" & CTo).Value = Right(Year(DFm), 2)
    WkTo.Range("C" & CTo).Value = Month(DFm)
    WkTo.Range("D" & CTo).Value = Day(DFm)
    
    '新規作成したsheetへ残高の計算を行う
    WkTo.Range("K" & CTo).Value = WkTo.Range("K" & CTo - 1).Value + CSum
     
   '新規作成したsheetへ罫線を取引数に応じた行数だけ作成
   'Q 僕の場合は下記のように記載。小川さんが解説してる通り、サブプロシージャー作成して分けるべきでしょうか?
    With Range("B" & CTo & ":" & "K" & CTo)
     .Borders(xlEdgeTop).LineStyle = xlContinuous
     .Borders(xlEdgeBottom).LineStyle = xlContinuous
     .Borders(xlEdgeRight).LineStyle = xlContinuous
     .Borders(xlEdgeLeft).LineStyle = xlContinuous
     .Borders(xlInsideVertical).LineStyle = xlContinuous
     .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End With
   CTo = CTo + 1
Next
End Sub

'sheet「mainの」A列へ番号を記入
Sub No_Create()
Dim CFm As Long
Dim WkFm As Worksheet
Set WkFm = Worksheets("main")
Dim CFmMax As Long
WkFm.Range("A1").Value = "No"
CFmMax = WkFm.Range("B65536").End(xlUp).Row

For CFm = 2 To CFmMax
    WkFm.Range("A" & CFm).Value = CFm - 1
Next

End Sub
'sheet「main」B列を昇順に並び替え
Sub Torihiki_Ascending_Order()
Dim WkFm As Worksheet
Dim CFmMax As Long
Set WkFm = Worksheets("main")
'**取引数が追加された場合を想定して下記の変数を追加**
CFmMax = WkFm.Range("G65536").End(xlUp).Row

 WkFm.Range("A1" & ":" & "G" & CFmMax).Sort _
 Key1:=WkFm.Range("B1"), _
 Order1:=xlAscending, _
 Header:=xlYes
End Sub

'sheet「main」A列を昇順に並び替え
Sub No_Ascending_Order()
Dim WkFm As Worksheet
Dim CFmMax As Long
Set WkFm = Worksheets("main")
'**取引数が追加された場合を想定して下記の変数を追加**
CFmMax = WkFm.Range("G65536").End(xlUp).Row

 WkFm.Range("A1" & ":" & "G" & CFmMax).Sort _
 Key1:=WkFm.Range("A1"), _
 Order1:=xlAscending, _
 Header:=xlYes
End Sub

'main1とmain以外のsheetを削除
Sub Depyo_Delete()
Dim Wks As Worksheet

For Each Wks In Worksheets
    Application.DisplayAlerts = False
    If Left(Wks.Name, 4) <> "main" Then
        Wks.Delete
    End If
Next
    Application.DisplayAlerts = True
End Sub
'念のため最後にA列のシートを初期化(多分これは必要ないと思う。)
Sub No_Reset()
Dim WkFm As Worksheet
Set WkFm = Worksheets("main")
    WkFm.Columns("A:A").ClearContents
End Sub

下記3点質問です

Q1:罫線に関して

取引先毎に罫線を引く作業ですが、あえて私は分けずに書いてみました。罫線に関しては小川さんが解説したとおり、サブプロシージャーに分けたほうがよろしいでしょうか?

Q2:変数名に関して
他のプロシージャーで同じ変数を使っています。
ex:WkFm、WkTo、CFmMax等

別のプロシージャーで同じ変数を使っていると、あまり綺麗ではないと感じています。変数名は異なる名前にしたほうがよろしいでしょうか?

Q3:プロシージャー名に関して
気の利いた名前が思いつかないので、結構適当になりました。
小川さんがプロシージャーの名前を付けるときに意識していることをご教示できればと思います。

以上よろしくお願いいたします。
2020/09/07 07:34