レッスン-投稿一覧パソコン仕事５倍塾ポータル

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

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

A.Sさんの投稿

(投稿ID: 4357) 添付ファイルのダウンロード権限がありません

小川先生

いつも分かり易い講座をありがとうございます。
発展編1 フォローメールセミナー第9回で宿題をいただいた伝票作成マクロを作成しましたので送らせていただきます。
自分なりに最初から作成していき、途中で詰まりながらも何とか最後まで辿り着き、動くところまで確認できました。
お忙しいところ大変恐れ入りますが、添削の程、どうぞよろしくお願い致します。

2019/02/05 05:32

小川慶一さんのコメント

(コメントID: 5986)

A.Sさん:

よくがんばりましたね (^^

全体の構想に問題があります。
見本と比べて再検討してください。

Denpyou_DataSetでお伝えしたとおり、不必要に処理が多いところもありす。
まだこの取引先数 x データ数なのでそれほどのロスではありませんが...。
これだと、「たとえば200件の取引先、3,000件のデータ」だとしたら、級数的に処理にかかる負荷が上がりますね。

と、いろいろ課題があります。

どういう処理のやり方だと、いちばんすっきりするか？
ここまで書ききれたからこそ分かることもあるでしょう。
見本のとおりに書くということをイチから行ってください。
それを2回くらい連続して行うと、すごく力がつくでしょう。

それからまた、イチから書き直してみてください。

Option Explicit
Dim ws As Worksheet '各取引先名シート
Dim wsm As Worksheet '「main」シート
Dim wsm1 As Worksheet '「main1」シート
Dim gyo As Long '「main」シート行変数
Dim gyot As Long '各取引先名シート行変数
Dim blast As Long '「main」シートB列の最後
Dim elast As Long '各取引先名シートE列の最後

'取引先毎の伝票シートを作成するマクロ
Public Sub DenpyouMake()
    'DenpyouSheet_Deleteがすべての作業より前に来るべきです。
    '「初期化」だからです。
    
    'そして、wsmの設定はこのタイミングで。
    'そして、すぐに、 wsm.select してしまいましょう。
    'そのほうがスッキリしたロジックになります。
    
    'つまり...。以下のとおり。そして、wsm, blast はいちいち再計算しない。
    '都度都度算出するなら、その変数は、モジュールレベル変数ではなく、プロシージャ内で宣言するもので。
'    DenpyouSheet_Delete
'    Set wsm = Worksheets("main")
'    wsm.Select
'    blast = wsm.Range("B" & Rows.Count).End(xlUp).Row
    
    Numbering '「main」シートのA列に番号を振るマクロの呼び出し
    Narabekae_Torihikisaki '「main」シートのB列を昇順に並び替えるマクロの呼び出し
    Denpyou_DataSet '取引先名称シートに伝票データをセットするマクロの呼び出し
    Narabekae_No '「main」シートのA列を昇順に並び替えるマクロ
End Sub


'「main」シートのA列に番号を振るマクロ
Private Sub Numbering()
    Set wsm = Worksheets("main")
    blast = wsm.Range("B" & Rows.Count).End(xlUp).Row
    Debug.Print "B列の最後="; blast
    
    wsm.Select
    Range("A1").Value = "No."
    For gyo = 2 To blast
        Range("A" & gyo).Value = gyo
    Next
End Sub

'「main」シートのB列を昇順に並び替えるマクロ
Private Sub Narabekae_Torihikisaki()
    Set wsm = Worksheets("main")
    blast = wsm.Range("B" & Rows.Count).End(xlUp).Row
    Debug.Print "B列の最後="; blast

    wsm.Select
    Range("B1").Select
    With wsm.Sort.SortFields
        .Clear
        .Add Key:=Range("B2:B" & blast), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    End With
    With wsm.Sort
        .SetRange Range("A1:G" & blast)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

'「main」シートのA列を昇順に並び替えるマクロ
Private Sub Narabekae_No()
    Set wsm = Worksheets("main")
    blast = wsm.Range("B" & Rows.Count).End(xlUp).Row
    Debug.Print "B列の最後="; blast

    wsm.Select
    Range("A1").Select
    With wsm.Sort.SortFields
        .Clear
        .Add Key:=Range("A2:A" & blast), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    End With
    With wsm.Sort
        .SetRange Range("A1:G" & blast)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

'取引先名称シートを作成するマクロ
Private Sub DenpyouSheet_Copy()
    DenpyouSheet_Delete '取引先名称シートを削除するマクロの呼び出し
    Set wsm = Worksheets("main")
    blast = wsm.Range("B" & Rows.Count).End(xlUp).Row
    Debug.Print "B列の最後="; blast

    For gyo = 2 To blast
        If wsm.Range("B" & gyo).Value <> wsm.Range("B" & gyo + 1).Value Then
            Sheets("main1").Copy After:=Sheets("main")
            Set ws = ActiveSheet
            ws.Name = wsm.Range("B" & gyo).Value
        End If
    Next
End Sub

'取引先名称シートに伝票データをセットするマクロ
Private Sub Denpyou_DataSet()
    DenpyouSheet_Copy '取引先名称シートを作成するマクロの呼び出し
    Set wsm = Worksheets("main")
    blast = wsm.Range("B" & Rows.Count).End(xlUp).Row
    Debug.Print "B列の最後="; blast
    Dim d As Date
    
    '以下のロジックだと、 worksheet の枚数 x (blast - 1)回の計算が発生しますね。
    '見本のやり方だと、 (blast -1)回で済みます。
    For Each ws In Worksheets
        If Left(ws.Name, 4) <> "main" Then
            ws.Activate
            gyot = 16
            For gyo = 2 To blast
                d = wsm.Range("C" & gyo).Value
                If ws.Name = wsm.Range("B" & gyo).Value Then
                    ws.Range("B" & gyot).Value = Right(Year(d), 2)
                    ws.Range("C" & gyot).Value = Month(d)
                    ws.Range("D" & gyot).Value = day(d)
                    ws.Range("E" & gyot).Value = wsm.Range("D" & gyo).Value
                    ws.Range("F" & gyot).Value = wsm.Range("E" & gyo).Value
                    ws.Range("H" & gyot).Value = wsm.Range("F" & gyo).Value
                    If wsm.Range("G" & gyo).Value > 0 Then
                        ws.Range("I" & gyot).Value = wsm.Range("G" & gyo).Value
                    Else
                        ws.Range("J" & gyot).Value = wsm.Range("G" & gyo).Value
                    End If
                    If gyot = 16 Then
                        ws.Range("K" & gyot).Value = wsm.Range("G" & gyo).Value
                    Else
                        ws.Range("K" & gyot).Value = wsm.Range("G" & gyo).Value + ws.Range("K" & gyot - 1).Value
                    End If
                    gyot = gyot + 1
                End If
            Next
            Keisen '取引先名称シートに罫線を作成するマクロの呼び出し
        End If
    Next
End Sub

'取引先名称シートに罫線を作成するマクロ
Private Sub Keisen()
    ws.Activate
    elast = ws.Range("E" & Rows.Count).End(xlUp).Row
    Debug.Print "E列の最後="; elast
    
    With Range("B16:K" & elast + 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 = xlHairline
        End With
    End With
    Range("A1").Select
End Sub

'取引先名称シートを削除するマクロ
Public Sub DenpyouSheet_Delete()
    Application.DisplayAlerts = False '警告を非表示にする
    For Each ws In Worksheets
        If Left(ws.Name, 4) <> "main" Then
            ws.Delete
        End If
    Next
    Application.DisplayAlerts = True '警告非表示解除
End Sub

2019/02/05 06:30

A.Sさんのコメント

(コメントID: 6019) 添付ファイルのダウンロード権限がありません

小川先生

お忙しい中、添削誠にありがとうございます。
ご教示いただきましたとおり、見本に沿って書くということを2回行った後に、最初からマクロを書き直しました。
再度、恐れ入りますが、添削の程、どうぞよろしくお願い致します。

Public Sub CreateDenpyo()
    DeleteSheets
    Numbering
    Narabekae_Torihikisaki
    Denpyosheet_Set
    Narabekae_No
End Sub

'「main」シートのA列に番号を振るマクロ
Private Sub Numbering()
    Dim ln As Long
    Dim lnMx As Long
    Dim ws As Worksheet
    Set ws = Worksheets("main")
    ws.Range("A1").Value = "No,"
    lnMx = ws.Range("B" & Rows.Count).End(xlUp).Row
    For ln = 2 To lnMx
        ws.Range("A" & ln).Value = ln
    Next
End Sub

'「main」シートのB列を昇順に並び替えるマクロ
Private Sub Narabekae_Torihikisaki()
    With Worksheets("main").Sort.SortFields
        .Clear
        .Add Key:=Range("B2:B317"), _
        SortOn:=xlSortOnValues, _
        Order:=xlAscending, _
        DataOption:=xlSortNormal
    End With
    With Worksheets("main").Sort
        .SetRange Range("A1:G317")
        .Header = xlYes
        .Apply
    End With
End Sub

'「main」シートのA列を昇順に並び替えるマクロ
Private Sub Narabekae_No()
    With Worksheets("main").Sort.SortFields
        .Clear
        .Add Key:=Range("A2:A317"), _
        SortOn:=xlSortOnValues, _
        Order:=xlAscending, _
        DataOption:=xlSortNormal
    End With
    With Worksheets("main").Sort
        .SetRange Range("A1:G317")
        .Header = xlYes
        .Apply
    End With
End Sub

'取引先毎の伝票シートを作成するマクロ
Private Sub Denpyosheet_Set()
    DeleteSheets
    Dim lnFm As Long
    Dim lnFmMx As Long
    Dim lnTo
    Dim st As String
    Dim wsFm As Worksheet
    Dim wsTo As Worksheet
    Dim dt As Date
    Set wsFm = Worksheets("main")
    lnFmMx = wsFm.Range("B" & Rows.Count).End(xlUp).Row
    For lnFm = 2 To lnFmMx
        If st <> wsFm.Range("B" & lnFm).Value Then
            If lnFm > 2 Then
                Keisen
            End If
            st = wsFm.Range("B" & lnFm).Value
            Sheets("main1").Copy After:=wsFm
            Set wsTo = ActiveSheet
            wsTo.Name = st
            lnTo = 16
        End If
        wsTo.Range("E" & lnTo).Value = wsFm.Range("D" & lnFm).Value
        wsTo.Range("F" & lnTo).Value = wsFm.Range("E" & lnFm).Value
        wsTo.Range("H" & lnTo).Value = wsFm.Range("F" & lnFm).Value
        If wsFm.Range("G" & lnFm).Value > 0 Then
            wsTo.Range("I" & lnTo).Value = wsFm.Range("G" & lnFm).Value
        Else
            wsTo.Range("J" & lnTo).Value = wsFm.Range("G" & lnFm).Value
        End If
        If lnTo = 16 Then
            wsTo.Range("K" & lnTo).Value = wsFm.Range("G" & lnFm).Value
        Else
            wsTo.Range("K" & lnTo).Value = wsFm.Range("G" & lnFm).Value + wsTo.Range("K" & lnTo).Offset(-1).Value
        End If
        dt = wsFm.Range("C" & lnFm).Value
        wsTo.Range("B" & lnTo).Value = Right(Year(dt), 2)
        wsTo.Range("C" & lnTo).Value = Month(dt)
        wsTo.Range("D" & lnTo).Value = Day(dt)
        lnTo = lnTo + 1
    Next
    Keisen
End Sub

'取引先名称シートを削除するマクロ
Public Sub DeleteSheets()
    Dim ws As Worksheet
    Application.DisplayAlerts = False
    For Each ws In Worksheets
        If Left(ws.Name, 4) <> "main" Then
            ws.Delete
        End If
    Next
    Application.DisplayAlerts = True
End Sub

'取引先名称シートに罫線を作成するマクロ
Private Sub Keisen()
    Dim lnMx As Long
    lnMx = Range("B" & Rows.Count).End(xlUp).Row
    With Range("B16:K" & lnMx + 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 = xlHairline
        End With
    End With
End Sub

2019/02/12 06:40

小川慶一さんのコメント

(コメントID: 6020)

A.Sさん:

拝見しました。

完璧に近いと思います。

ご自身の感触としてはどうでしょうか。

> 小川先生
>
> お忙しい中、添削誠にありがとうございます。
> ご教示いただきましたとおり、見本に沿って書くということを2回行った後に、最初からマクロを書き直しました。
> 再度、恐れ入りますが、添削の程、どうぞよろしくお願い致します。
>
>

Public Sub CreateDenpyo()
>     DeleteSheets
>     Numbering
>     Narabekae_Torihikisaki
>     Denpyosheet_Set
>     Narabekae_No
> End Sub
> 
> '「main」シートのA列に番号を振るマクロ
> Private Sub Numbering()
>     Dim ln As Long
>     Dim lnMx As Long
>     Dim ws As Worksheet
>     Set ws = Worksheets("main")
>     ws.Range("A1").Value = "No,"
>     lnMx = ws.Range("B" & Rows.Count).End(xlUp).Row
>     For ln = 2 To lnMx
>         ws.Range("A" & ln).Value = ln
>     Next
> End Sub
> 
> '「main」シートのB列を昇順に並び替えるマクロ
> Private Sub Narabekae_Torihikisaki()
>     With Worksheets("main").Sort.SortFields
>         .Clear
>         .Add Key:=Range("B2:B317"), _
>         SortOn:=xlSortOnValues, _
>         Order:=xlAscending, _
>         DataOption:=xlSortNormal
>     End With
>     With Worksheets("main").Sort
>         .SetRange Range("A1:G317")
>         .Header = xlYes
>         .Apply
>     End With
> End Sub
> 
> '「main」シートのA列を昇順に並び替えるマクロ
> Private Sub Narabekae_No()
>     With Worksheets("main").Sort.SortFields
>         .Clear
>         .Add Key:=Range("A2:A317"), _
>         SortOn:=xlSortOnValues, _
>         Order:=xlAscending, _
>         DataOption:=xlSortNormal
>     End With
>     With Worksheets("main").Sort
>         .SetRange Range("A1:G317")
>         .Header = xlYes
>         .Apply
>     End With
> End Sub
> 
> '取引先毎の伝票シートを作成するマクロ
> Private Sub Denpyosheet_Set()
>     DeleteSheets
>     Dim lnFm As Long
>     Dim lnFmMx As Long
>     Dim lnTo
>     Dim st As String
>     Dim wsFm As Worksheet
>     Dim wsTo As Worksheet
>     Dim dt As Date
>     Set wsFm = Worksheets("main")
>     lnFmMx = wsFm.Range("B" & Rows.Count).End(xlUp).Row
>     For lnFm = 2 To lnFmMx
>         If st <> wsFm.Range("B" & lnFm).Value Then
>             If lnFm > 2 Then
>                 Keisen
>             End If
>             st = wsFm.Range("B" & lnFm).Value
>             Sheets("main1").Copy After:=wsFm
>             Set wsTo = ActiveSheet
>             wsTo.Name = st
>             lnTo = 16
>         End If
>         wsTo.Range("E" & lnTo).Value = wsFm.Range("D" & lnFm).Value
>         wsTo.Range("F" & lnTo).Value = wsFm.Range("E" & lnFm).Value
>         wsTo.Range("H" & lnTo).Value = wsFm.Range("F" & lnFm).Value
>         If wsFm.Range("G" & lnFm).Value > 0 Then
>             wsTo.Range("I" & lnTo).Value = wsFm.Range("G" & lnFm).Value
>         Else
>             wsTo.Range("J" & lnTo).Value = wsFm.Range("G" & lnFm).Value
>         End If
>         If lnTo = 16 Then
>             wsTo.Range("K" & lnTo).Value = wsFm.Range("G" & lnFm).Value
>         Else
>             wsTo.Range("K" & lnTo).Value = wsFm.Range("G" & lnFm).Value + wsTo.Range("K" & lnTo).Offset(-1).Value
>         End If
>         dt = wsFm.Range("C" & lnFm).Value
>         wsTo.Range("B" & lnTo).Value = Right(Year(dt), 2)
>         wsTo.Range("C" & lnTo).Value = Month(dt)
>         wsTo.Range("D" & lnTo).Value = Day(dt)
>         lnTo = lnTo + 1
>     Next
>     Keisen
> End Sub
> 
> '取引先名称シートを削除するマクロ
> Public Sub DeleteSheets()
>     Dim ws As Worksheet
>     Application.DisplayAlerts = False
>     For Each ws In Worksheets
>         If Left(ws.Name, 4) <> "main" Then
>             ws.Delete
>         End If
>     Next
>     Application.DisplayAlerts = True
> End Sub
> 
> '取引先名称シートに罫線を作成するマクロ
> Private Sub Keisen()
>     Dim lnMx As Long
>     lnMx = Range("B" & Rows.Count).End(xlUp).Row
>     With Range("B16:K" & lnMx + 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 = xlHairline
>         End With
>     End With
> End Sub

2019/02/12 07:28

A.Sさんのコメント

(コメントID: 6021)

小川先生

コメントありがとうございます。
見本に沿って書いてみてから再度最初から何も見ないで
書こうとしたところ、不思議と何処から手を付ければ良いのか
頭の中でイメージが出来ましたので、殆ど迷うことなく
書き上げることが出来ました。

これもひとえに小川先生のご教示があったからこそと
大変感謝の気持ちで一杯です。
現在、発展編1を受講中ですので、更にレベルを上げられるように
精進して参りたいと思います。
今後とも、ご指導の程、よろしくお願い致します。

2019/02/12 08:43

小川慶一さんのコメント

(コメントID: 6027)

A.Sさん:

よかったです。

講座で学ぶ
↓
演習を解いてみる
↓
再度講座を見直す
↓
リトライする

というステップは、プログラミング言語習得でとても大切です。
というか、ここがしっかりできるならば、僕はあまり必要ではありませんw

特に、一度書いてみてから見本の流れを再確認するのが大事です。
すると、以前には見えなかったレベルで細かいところまで目が行くようになると同時に、全体を俯瞰する目も養われます。

> 小川先生
>
> コメントありがとうございます。
> 見本に沿って書いてみてから再度最初から何も見ないで
> 書こうとしたところ、不思議と何処から手を付ければ良いのか
> 頭の中でイメージが出来ましたので、殆ど迷うことなく
> 書き上げることが出来ました。
>
> これもひとえに小川先生のご教示があったからこそと
> 大変感謝の気持ちで一杯です。
> 現在、発展編1を受講中ですので、更にレベルを上げられるように
> 精進して参りたいと思います。
> 今後とも、ご指導の程、よろしくお願い致します。

2019/02/14 06:33