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

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

受講生さんの投稿

(投稿ID: 4704)

いつもお世話になっております。
添削よろしくお願いいたします。
Publicの使い方について、後々修正が必要となったとき、1カ所修正で済むようにと思い、以下のように作成しましたが、逆にやりにくさが出たりするのでしょうか。（作成中はsubプロシージャごと変数へ格納しなければならないので、ちょっとめんどくさいなと感じました）
効果的なPublicの使い方をしているか不安です。
よろしくお願いいたします。
Option Explicit

Public shFm As Worksheet
Public shTo As Worksheet
Public lnFmMx As Long
Sub zikkou()
    Set shFm = Worksheets("main")
    lnFmMx = shFm.Range("B" & Rows.Count).End(xlUp).Row
    sakuzyo
    bango
    narabikae
    sakusei

End Sub


Sub bango()
'    Set shFm = Worksheets("main")
'    lnFmMx = shFm.Range("B" & Rows.Count).End(xlUp).Row
    
    Dim lnFm As Long
    
    shFm.Range("A1").Value = "No."
    For lnFm = 2 To lnFmMx
        shFm.Range("A" & lnFm).Value = lnFm - 1
    Next
End Sub

Sub narabikae()
'    Set shFm = Worksheets("main")
'    lnFmMx = shFm.Range("B" & Rows.Count).End(xlUp).Row
    
    shFm.Sort.SortFields.Clear
    shFm.Sort.SortFields.Add2 _
        Key:=Range("B2:B" & lnFmMx), _
        SortOn:=xlSortOnValues, _
        Order:=xlAscending, _
        DataOption:=xlSortNormal
    With shFm.Sort
        .SetRange Range("A1:G" & lnFmMx)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    shFm.Range("A1").Select
End Sub

Sub sakusei()
'    Set shFm = Worksheets("main")
'    lnFmMx = shFm.Range("B" & Rows.Count).End(xlUp).Row
    
    Dim lnTo As Long
    Dim lnFm As Long
    Dim st As String
    Dim dt As Date
    
    For lnFm = 2 To lnFmMx
        If shFm.Range("B" & lnFm).Value <> shFm.Range("B" & lnFm - 1).Value Then
            If lnFm <> 2 Then
                koushisen
            End If
            st = shFm.Range("B" & lnFm).Value
            Sheets("main1").Copy After:=Sheets(2)
            Set shTo = ActiveSheet
            shTo.Name = st
            lnTo = 16
            
        End If
        shTo.Range("E" & lnTo).Value = shFm.Range("D" & lnFm).Value
        shTo.Range("F" & lnTo).Value = shFm.Range("E" & lnFm).Value
        shTo.Range("H" & lnTo).Value = shFm.Range("F" & lnFm).Value
        If shFm.Range("G" & lnFm).Value > 0 Then
            shTo.Range("I" & lnTo).Value = shFm.Range("G" & lnFm).Value
        Else
            shTo.Range("J" & lnTo).Value = shFm.Range("G" & lnFm).Value
        End If
        If lnTo = 16 Then
            shTo.Range("K" & lnTo).Value = shFm.Range("G" & lnFm).Value
        Else
            shTo.Range("K" & lnTo).Value = shFm.Range("G" & lnFm).Value + shTo.Range("K" & lnTo).Offset(-1).Value
        End If
        dt = shFm.Range("C" & lnFm).Value
        shTo.Range("B" & lnTo).Value = Right(Year(dt), 2)
        shTo.Range("C" & lnTo).Value = Month(Date)
        shTo.Range("D" & lnTo).Value = Day(dt)
        lnTo = lnTo + 1
    Next
    koushisen
End Sub
Sub koushisen()
    'Set shTo = Worksheets("?{??@??")
    Dim lnToMx As Long
    lnToMx = shTo.Range("B" & Rows.Count).End(xlUp).Row
    With shTo.Range("B16:K" & lnToMx + 1)
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
    End With

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

End Sub

2020/05/05 23:50