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

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

加藤さんの投稿

(投稿ID: 4958)

予習のコードです。
メールを読むのはこれからですが、H列に合計を入れるところや罫線は、もっと効率の良い方法があるのではと楽しみです。
Sub day7yoshu()
    Delete_Sheets
    Dim shFm As Worksheet
    Dim InFm As Long
    Dim InFmMx As Long
    Dim st As String
    Dim shTo As Worksheet
    Dim dt As Date
    Dim gyo As Long
    Set shFm = Worksheets("main")
    InFmMx = shFm.Range("B65536").End(xlUp).Row
    For InFm = 2 To InFmMx
        If st <> shFm.Range("B" & InFm).Value Then
            Debug.Print shFm.Range("B" & InFm).Value
            st = shFm.Range("B" & InFm).Value
            Sheets("main1").Copy After:=Sheets(2)
            Set shTo = ActiveSheet
            shTo.Name = st
            gyo = 16
        End If
        If shFm.Range("G" & InFm).Value < 0 Then
            '貸方に負の数が入らないよう、右辺はマイナスとした。
            shTo.Range("J" & gyo).Value = -shFm.Range("G" & InFm).Value
        Else
            shTo.Range("I" & gyo).Value = shFm.Range("G" & InFm).Value
        End If
        dt = shFm.Range("C" & InFm).Value
        shTo.Range("H" & gyo).Value = shFm.Range("F" & InFm).Value
        shTo.Range("E" & gyo).Value = shFm.Range("D" & InFm).Value
        shTo.Range("F" & gyo).Value = shFm.Range("E" & InFm).Value
        shTo.Range("B" & gyo).Value = Right(Year(dt), 2)
        shTo.Range("C" & gyo).Value = Month(dt)
        shTo.Range("D" & gyo).Value = Day(dt)
        If gyo = 16 Then
            shTo.Range("K" & gyo).Value = shTo.Range("I" & gyo).Value - shTo.Range("J" & gyo).Value
        ElseIf gyo > 16 Then
            shTo.Range("K" & gyo).Value = shTo.Range("I" & gyo).Value - shTo.Range("J" & gyo).Value + shTo.Range("K" & gyo - 1).Value
        End If
        shTo.Range("B" & gyo & ":K" & gyo).Select
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        gyo = gyo + 1
    Next
End Sub

Sub Delete_Sheets()
    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/12/26 10:42