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

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

受講生さんの投稿

(投稿ID: 1917)

小川先生、いつも大変お世話になっております。

昨年12月から受講開始した発展編の視聴が一通り終了しましたので、
年明けからフォローアップメールセミナーの伝票作成マクロに取り掛かってきました。
発展編での学びを定着させるのにとても勉強になっております。
実務の方でも非常に役に立っており、大変感謝致しております。

この伝票作成マクロの動画を通じて、withブロックの中身を置換でシンプルに修正する方法が
大変参考になりました。
またテスト時のブレークポイントの設定についても良い復習となり、
実務の方で活かしていきたいと実感しました。

以下に宿題を投稿させて頂きます。
先生の動画を視聴した直後に作成しましたので、殆ど先生のコードと違わないとは思いますが、
いざ自分で作ってみるとなると、罫線を引くタイミングが難しくて、
特にmainシートに罫線が引かれてしまう時の回避策がどうしても思いつかず、
単純に、”シート名がmainでなければ”、という表現となってしまいましたが･･･(・∀・;)
よろしくお願いいたします。
Sub deleteDenpyo()
    Dim ws As Worksheet
    Application.DisplayAlerts = False
    For Each ws In Worksheets
        If ws.Name <> "main" And ws.Name <> "main1" Then
            ws.Delete
        End If
    Next
    Application.DisplayAlerts = True
End Sub

Sub createDenpyo()
    deleteDenpyo
    
    Dim wFm As Worksheet
    Dim wTo As Worksheet
    Set wFm = Worksheets("main")

'日付の昇順に番号振る
    Dim gyoMax As Long
    gyoMax = wFm.Range("B" & Rows.Count).End(xlUp).Row
    Dim gyo As Long
    For gyo = 2 To gyoMax
        wFm.Range("A" & gyo).Value = gyo - 1
    Next
    
'B列ソート
    wFm.Range("A2:G317").Sort Key1:=wFm.Range("B1"), Order1:=xlAscending, Header:=xlYes
    
'伝票作成
    Dim gyoTo As Long
    For gyo = 2 To gyoMax
        '取引先名称が違えばシートを作る
        If wFm.Range("B" & gyo).Value <> wFm.Range("B" & gyo - 1).Value Then
            If ActiveSheet.Name <> "main" Then
                keisen
            End If
            Sheets("main1").Copy After:=Sheets(2)
            Set wTo = Sheets("main1 (2)")
            wTo.Name = wFm.Range("B" & gyo).Value
            gyoTo = 16
        End If
        'シートを作成後、データを投入していく
        wTo.Range("B" & gyoTo).Value = Mid(Year(wFm.Range("C" & gyo).Value), 3)
        wTo.Range("C" & gyoTo).Value = Month(wFm.Range("C" & gyo).Value)
        wTo.Range("D" & gyoTo).Value = Day(wFm.Range("C" & gyo).Value)
        
        wTo.Range("E" & gyoTo).Value = wFm.Range("D" & gyo).Value
        wTo.Range("F" & gyoTo).Value = wFm.Range("E" & gyo).Value
        wTo.Range("H" & gyoTo).Value = wFm.Range("F" & gyo).Value
        If wFm.Range("G" & gyo).Value > 0 Then
            wTo.Range("I" & gyoTo).Value = wFm.Range("G" & gyo).Value
        Else
            wTo.Range("J" & gyoTo).Value = wFm.Range("G" & gyo).Value
        End If
        If gyoTo = 16 Then
            wTo.Range("K" & gyoTo).Value = wTo.Range("I" & gyoTo).Value + wTo.Range("J" & gyoTo).Value
        Else
            wTo.Range("K" & gyoTo).Value = wTo.Range("K" & gyoTo - 1).Value + wTo.Range("I" & gyoTo).Value + wTo.Range("J" & gyoTo).Value
        End If
        gyoTo = gyoTo + 1
    Next
        keisen
End Sub

Sub keisen()
    Dim gyoToMax
    gyoToMax = Range("B" & Rows.Count).End(xlUp).Row
    Range("B16:K" & gyoToMax).Select
    
    With Range("B16:K" & gyoToMax)
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlHairline
        End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlHairline
        End With
    
    End With
    
End Sub

2016/01/18 04:19