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

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

受講生さんの投稿

(投稿ID: 1927)

小川先生、いつもお世話になっております。
追加要件の宿題を提出いたします。前回の宿題提出時に頂いたご指導のお陰で、ループの初回の罫線設定回避策もよく理解出来て、スラスラと書けるようになりました。
今回はオートフィルでA列に番号を振る別解としました。オートフィルのハンドル部分をダブルクリックするだけで、表がある部分全てにオートフィルが実行されることは知らなかったので、
また新たな学びが出来ました。（今更というカンジですが…(;・∀・)）添削ご指導よろしくお願いいたします。
Sub creatDenpyo()
    deleteDenpyo
    
    Dim wFm As Worksheet
    Set wFm = Worksheets("main")
    Dim wTmp As Worksheet
    Set wTmp = Worksheets("main1")
    Dim wTo As Worksheet
    
    '(1)A列に番号を振る(オートフィルで)
    wFm.Range("A2").FormulaR1C1 = "1"
    wFm.Range("A3").FormulaR1C1 = "2"
    wFm.Range("A2:A3").AutoFill Destination:=wFm.Range("A2:A317")

    '(2)B列でソート
    wFm.Range("A1:G317").Sort Key1:=wFm.Range("B1"), Order1:=xlAscending, Header:=xlYes

    '(3)伝票テンプレートにヘッダー/フッター挿入、印刷範囲設定クリア
    With wTmp.PageSetup
        .CenterHeader = "&A"
        .CenterFooter = "&P / &N ページ"
        .PrintArea = ""
    End With
    
    '(4)伝票作成
    Dim gyo As Long
    Dim gyoMax As Long
    gyoMax = wFm.Range("B" & Rows.Count).End(xlUp).Row
    Dim gyoTo As Long
    gyoTo = 16
    For gyo = 2 To gyoMax
        If wFm.Range("B" & gyo).Value <> wFm.Range("B" & gyo - 1).Value Then
            If gyo > 2 Then
                keisen
            End If
            gyoTo = 16
            wTmp.Copy After:=Sheets(2)
            Set wTo = ActiveSheet
            wTo.Name = wFm.Range("B" & gyo).Value
        End If
        wTo.Range("B" & gyoTo) = Mid(Year(wFm.Range("C" & gyo).Value), 3)
        wTo.Range("C" & gyoTo) = Month(wFm.Range("C" & gyo).Value)
        wTo.Range("D" & gyoTo) = Day(wFm.Range("C" & gyo).Value)
        wTo.Range("E" & gyoTo) = wFm.Range("D" & gyo).Value
        wTo.Range("F" & gyoTo) = wFm.Range("E" & gyo).Value
        wTo.Range("H" & gyoTo) = wFm.Range("F" & gyo).Value
        If wFm.Range("G" & gyo).Value > 0 Then
            wTo.Range("I" & gyoTo) = wFm.Range("G" & gyo).Value
        Else
            wTo.Range("J" & gyoTo) = wFm.Range("G" & gyo).Value
        End If
        If gyoTo > 16 Then
            wTo.Range("K" & gyoTo) = wTo.Range("I" & gyoTo).Value + wTo.Range("J" & gyoTo).Value + wTo.Range("K" & gyoTo - 1).Value
        Else
            wTo.Range("K" & gyoTo) = wTo.Range("I" & gyoTo).Value + wTo.Range("J" & gyoTo).Value
        End If
        gyoTo = gyoTo + 1
    Next
    keisen

    '(5)A列でソート
    wFm.Range("A1:G317").Sort Key1:=wFm.Range("A1"), Order1:=xlAscending, Header:=xlYes

    '(6)A列の値消去
    wFm.Range("A1:A317").ClearContents
End Sub

Sub deleteDenpyo()
    Dim ws As Worksheet
    Application.DisplayAlerts = False
    For Each ws In Worksheets
        If ws.Name <> "main1" And ws.Name <> "main" Then
            ws.Delete
        End If
    Next
    Application.DisplayAlerts = True
End Sub

Sub keisen()
    Dim gyoMax
    gyoMax = Range("B" & Rows.Count).End(xlUp).Row
    
    With Range("B16", "K" & gyoMax)
        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/25 00:06