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

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

HKさんの投稿

(投稿ID: 3926)

私も9411でコメントされている受講生さんと同じように、自分で作ったプログラムでは罫線を引く作業は別のサブプロシージャを作成しました。

また、残高の計算も、変数を使用して、条件分岐をしなくてもいいように作ってみました。（条件分岐を考えるのがめんどくさいのでなるべく避けるように作ってしまいます）

先生のやり方も出来るように練習したいと思います。
Sub GetNames_Final()
    DeleteSheets_Fin
    
    Dim lnGyo As Long
    Dim lnGyoMx As Long
    Dim wsMain As Worksheet
    Dim stCompany As String
    Dim wsSaki As Worksheet
    Dim dt As Date
    Dim lnSaki As Long
    Dim lnZandaka As Long
    
    Set wsMain = Worksheets("main")
    lnGyoMx = wsMain.Range("B" & wsMain.Rows.Count).End(xlUp).Row
    
    For lnGyo = 2 To lnGyoMx
        If stCompany <> wsMain.Range("B" & lnGyo).Value Then
            stCompany = wsMain.Range("B" & lnGyo).Value
'            Debug.Print wsMain.Range("B" & lnGyo).Value
            Worksheets("main1").Copy after:=Worksheets(Worksheets.Count)
            Set wsSaki = Worksheets(Worksheets.Count)
            wsSaki.Name = stCompany
            lnSaki = 16
            lnZandaka = 0
        End If
        
        wsSaki.Range("H" & lnSaki).Value = wsMain.Range("F" & lnGyo).Value
        wsSaki.Range("E" & lnSaki).Value = wsMain.Range("D" & lnGyo).Value
        wsSaki.Range("F" & lnSaki).Value = wsMain.Range("E" & lnGyo).Value
        If wsMain.Range("G" & lnGyo).Value > 0 Then
            wsSaki.Range("I" & lnSaki).Value = wsMain.Range("G" & lnGyo).Value
        Else
            wsSaki.Range("J" & lnSaki).Value = wsMain.Range("G" & lnGyo).Value
        End If
        
        '残高の計算
        lnZandaka = lnZandaka + wsSaki.Range("I" & lnSaki).Value + wsSaki.Range("J" & lnSaki).Value
        wsSaki.Range("K" & lnSaki).Value = lnZandaka
        
        dt = wsMain.Range("C" & lnGyo).Value
        wsSaki.Range("B" & lnSaki).Value = Right(Year(dt), 2)
        wsSaki.Range("C" & lnSaki).Value = Month(dt)
        wsSaki.Range("D" & lnSaki).Value = Day(dt)

        lnSaki = lnSaki + 1
    Next
    
    '罫線を引く
    Keisen
End Sub

Sub Keisen()
    Dim ws As Worksheet
    Dim lnGyoMx As Long
    For Each ws In Worksheets
        Select Case ws.Name
            Case Is = "main", "main1"
            Case Else
                lnGyoMx = ws.Range("B" & ws.Rows.Count).End(xlUp).Row
                ws.Range("B16:K" & lnGyoMx).Borders.LineStyle = xlContinuous
        End Select
    Next
End Sub

Sub DeleteSheets_Fin()
    Dim ws As Worksheet
    For Each ws In Worksheets
        Select Case ws.Name
            Case Is = "main", "main1"
            Case Else
                Application.DisplayAlerts = False
                ws.Delete
                Application.DisplayAlerts = True
        End Select
    Next
End Sub

2018/05/29 22:11