エクセルマクロ オンライン講座コメント紹介

コメント紹介
   └ 発展編1 フォローメールセミナー
       └ 発展編1 フォローメールセミナー 第9回

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

[10259] 2018-07-13 22:31:16 のんのんさんからの投稿です。

こんにちは。
伝票作成のマクロ作ってみました。
添削よろしくお願いします☆

Option Explicit

Dim cmMax As Long
Dim cCnt As Long
Dim wMn As Worksheet
Dim wMn1 As Worksheet
Dim wNs As Worksheet
Dim sRetsu As String
Dim cNcnt As Long
Dim cnMax As Long

Sub CreateDenpyo()
    Call rowAnumbering
    sRetsu = "B"
    Call sorting
    ExeCreateDenpyo
    Worksheets("main").Select
    sRetsu = "A"
    sorting
End Sub

Sub rowAnumbering()
    Set wMn = Worksheets("main")
    cmMax = wMn.Range("B" & Rows.Count).End(xlUp).Row
    wMn.Range("A1").Value = "No."
    For cCnt = 2 To cmMax
        wMn.Range("A" & cCnt).Value = cCnt - 1
    Next
End Sub

Sub sorting()
    Set wMn = Worksheets("main")
    cmMax = wMn.Range("B" & Rows.Count).End(xlUp).Row
    
    wMn.Sort.SortFields.Clear
    wMn.Sort.SortFields.Add Key:=Range(sRetsu & "2:" & sRetsu & cmMax), _
        SortOn:=xlSortOnValues, _
        Order:=xlAscending, _
        DataOption:=xlSortNormal
    With wMn.Sort
        .SetRange Range("A1:G" & cmMax)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Sub ExeCreateDenpyo()
    Call DeleteSheet
    Set wMn = Worksheets("main")
    cmMax = wMn.Range("B" & Rows.Count).End(xlUp).Row
    Set wMn1 = Worksheets("main1")
    
    For cCnt = 1 To cmMax
        If wMn.Range("B" & cCnt).Value <> wMn.Range("B" & cCnt + 1).Value And wMn.Range("B" & cCnt + 1).Value <> "" Then
            If cCnt <> 1 Then
                Call keisen
            End If
            wMn1.Copy After:=Sheets(2)
            ActiveSheet.Name = wMn.Range("B" & cCnt + 1).Value
            Set wNs = Worksheets(ActiveSheet.Name)
            
            cNcnt = 16
            wNs.Range("B" & cNcnt).Value = Right(Year(wMn.Range("C" & cCnt + 1).Value), 2)
            wNs.Range("C" & cNcnt).Value = Month(wMn.Range("C" & cCnt + 1).Value)
            wNs.Range("D" & cNcnt).Value = Day(wMn.Range("C" & cCnt + 1).Value)
            wNs.Range("E" & cNcnt).Value = wMn.Range("D" & cCnt + 1).Value
            wNs.Range("F" & cNcnt).Value = wMn.Range("E" & cCnt + 1).Value
            wNs.Range("H" & cNcnt).Value = wMn.Range("F" & cCnt + 1).Value
            If wMn.Range("G" & cCnt + 1).Value > 0 Then
                wNs.Range("I" & cNcnt).Value = wMn.Range("G" & cCnt + 1).Value
            Else
                wNs.Range("J" & cNcnt).Value = wMn.Range("G" & cCnt + 1).Value
            End If
            wNs.Range("K" & cNcnt).Value = wNs.Range("I" & cNcnt).Value + wNs.Range("J" & cNcnt).Value
            cNcnt = cNcnt + 1
        ElseIf wMn.Range("B" & cCnt).Value = wMn.Range("B" & cCnt + 1).Value And wMn.Range("B" & cCnt + 1).Value <> "" Then
            wNs.Range("B" & cNcnt).Value = Right(Year(wMn.Range("C" & cCnt + 1).Value), 2)
            wNs.Range("C" & cNcnt).Value = Month(wMn.Range("C" & cCnt + 1).Value)
            wNs.Range("D" & cNcnt).Value = Day(wMn.Range("C" & cCnt + 1).Value)
            wNs.Range("E" & cNcnt).Value = wMn.Range("D" & cCnt + 1).Value
            wNs.Range("F" & cNcnt).Value = wMn.Range("E" & cCnt + 1).Value
            wNs.Range("H" & cNcnt).Value = wMn.Range("F" & cCnt + 1).Value
            If wMn.Range("G" & cCnt + 1).Value > 0 Then
                wNs.Range("I" & cNcnt).Value = wMn.Range("G" & cCnt + 1).Value
            Else
                wNs.Range("J" & cNcnt).Value = wMn.Range("G" & cCnt + 1).Value
            End If
            wNs.Range("K" & cNcnt).Value = wNs.Range("I" & cNcnt).Value + wNs.Range("J" & cNcnt).Value + wNs.Range("K" & cNcnt - 1).Value
            cNcnt = cNcnt + 1
        End If
        If cCnt = cmMax Then
            Call keisen
        End If
    Next
End Sub

Sub DeleteSheet()
    Application.DisplayAlerts = False
    For Each wNs In Worksheets
        If Left(wNs.Name, 4) <> "main" Then
            wNs.Delete
        End If
    Next
    Application.DisplayAlerts = True
End Sub

Sub keisen()
    cnMax = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
    Range("B16:K" & cnMax).Borders.LineStyle = xlContinuous
End Sub

 


[10266] 2018-07-16 23:51:11 小川慶一さんからの投稿です。

のんのんさん:

添削を返送します。

コメントを参考にして再度挑戦してください。

Option Explicit

'モジュールレベル変数は、変数宣言の回数を減らす目的で使うものではありません。
'複数プロシージャ間で値の引き渡しをしたいときだけに使います。
'個々のプロシージャ内で完結する処理では使うとメンテナンス性が落ちるためです。
'以下でそういう意味で本当に使っている意味があるのは、 sRetsuだけです。
'発展編1の「モジュールレベル変数」の項目を復習してください。 ogawa
Dim cmMax As Long
Dim cCnt As Long
Dim wMn As Worksheet
Dim wMn1 As Worksheet
Dim wNs As Worksheet
Dim sRetsu As String
Dim cNcnt As Long
Dim cnMax As Long

Sub CreateDenpyo()
    Call rowAnumbering
    sRetsu = "B"
    Call sorting
    ExeCreateDenpyo
    Worksheets("main").Select
    sRetsu = "A"
    sorting
End Sub

Sub rowAnumbering()
    '↓Format関数の活用も検討してください。ogawa
    Set wMn = Worksheets("main")
    cmMax = wMn.Range("B" & Rows.Count).End(xlUp).Row
    wMn.Range("A1").Value = "No."
    For cCnt = 2 To cmMax
        wMn.Range("A" & cCnt).Value = cCnt - 1
    Next
End Sub

Sub sorting()
    Set wMn = Worksheets("main")
    cmMax = wMn.Range("B" & Rows.Count).End(xlUp).Row
    
    wMn.Sort.SortFields.Clear
    wMn.Sort.SortFields.Add Key:=Range(sRetsu & "2:" & sRetsu & cmMax), _
        SortOn:=xlSortOnValues, _
        Order:=xlAscending, _
        DataOption:=xlSortNormal
    With wMn.Sort
        .SetRange Range("A1:G" & cmMax)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Sub ExeCreateDenpyo()
    Call DeleteSheet
    Set wMn = Worksheets("main")
    cmMax = wMn.Range("B" & Rows.Count).End(xlUp).Row
    Set wMn1 = Worksheets("main1")
    
    '「次の行と違ったら」という条件で、作業対象のセルを cCnt + 1 と表現するか。
    '「前の行と違ったら」という条件で、作業対象のセルを cCnt     と表現するか。
    'というところが見本との違いですね。
    '比較すると、提出いただいたプログラムは、記述が面倒なうえ、条件文が見本よりややこしいと感じます。ogawa
    For cCnt = 1 To cmMax
        If wMn.Range("B" & cCnt).Value <> wMn.Range("B" & cCnt + 1).Value And wMn.Range("B" & cCnt + 1).Value <> "" Then
            If cCnt <> 1 Then
                Call keisen
            End If
            wMn1.Copy After:=Sheets(2)
            ActiveSheet.Name = wMn.Range("B" & cCnt + 1).Value
            Set wNs = Worksheets(ActiveSheet.Name)
            
            cNcnt = 16
            '以下は ElseIf 以下で書かれていることと重複している部分については2回書かないで済むような書き方を検討してください。 ogawa
            wNs.Range("B" & cNcnt).Value = Right(Year(wMn.Range("C" & cCnt + 1).Value), 2)
            wNs.Range("C" & cNcnt).Value = Month(wMn.Range("C" & cCnt + 1).Value)
            wNs.Range("D" & cNcnt).Value = Day(wMn.Range("C" & cCnt + 1).Value)
            wNs.Range("E" & cNcnt).Value = wMn.Range("D" & cCnt + 1).Value
            wNs.Range("F" & cNcnt).Value = wMn.Range("E" & cCnt + 1).Value
            wNs.Range("H" & cNcnt).Value = wMn.Range("F" & cCnt + 1).Value
            If wMn.Range("G" & cCnt + 1).Value > 0 Then
                wNs.Range("I" & cNcnt).Value = wMn.Range("G" & cCnt + 1).Value
            Else
                wNs.Range("J" & cNcnt).Value = wMn.Range("G" & cCnt + 1).Value
            End If
            wNs.Range("K" & cNcnt).Value = wNs.Range("I" & cNcnt).Value + wNs.Range("J" & cNcnt).Value
            cNcnt = cNcnt + 1
        ElseIf wMn.Range("B" & cCnt).Value = wMn.Range("B" & cCnt + 1).Value And wMn.Range("B" & cCnt + 1).Value <> "" Then
            wNs.Range("B" & cNcnt).Value = Right(Year(wMn.Range("C" & cCnt + 1).Value), 2)
            wNs.Range("C" & cNcnt).Value = Month(wMn.Range("C" & cCnt + 1).Value)
            wNs.Range("D" & cNcnt).Value = Day(wMn.Range("C" & cCnt + 1).Value)
            wNs.Range("E" & cNcnt).Value = wMn.Range("D" & cCnt + 1).Value
            wNs.Range("F" & cNcnt).Value = wMn.Range("E" & cCnt + 1).Value
            wNs.Range("H" & cNcnt).Value = wMn.Range("F" & cCnt + 1).Value
            If wMn.Range("G" & cCnt + 1).Value > 0 Then
                wNs.Range("I" & cNcnt).Value = wMn.Range("G" & cCnt + 1).Value
            Else
                wNs.Range("J" & cNcnt).Value = wMn.Range("G" & cCnt + 1).Value
            End If
            wNs.Range("K" & cNcnt).Value = wNs.Range("I" & cNcnt).Value + wNs.Range("J" & cNcnt).Value + wNs.Range("K" & cNcnt - 1).Value
            cNcnt = cNcnt + 1
        End If
        '↓ここでこの処理をするのと、見本のように、取引先が変わるときだけやるのとでは、どちらのほうがより効率的か?
        '  例えば、取引先数30件、データ行数100,000だったとしたら?
        '  見本のやり方なら30回で済みます。このプログラムでは、100,000回処理をすることになりますね。 ogawa
        If cCnt = cmMax Then
            Call keisen
        End If
    Next
End Sub

Sub DeleteSheet()
    Application.DisplayAlerts = False
    For Each wNs In Worksheets
        If Left(wNs.Name, 4) <> "main" Then
            wNs.Delete
        End If
    Next
    Application.DisplayAlerts = True
End Sub

Sub keisen()
    cnMax = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
    Range("B16:K" & cnMax).Borders.LineStyle = xlContinuous
End Sub


> こんにちは。
> 伝票作成のマクロ作ってみました。
> 添削よろしくお願いします☆

 


まずはここから!スマホでも学べる無料動画講座

今なら先着30名限定で無料!定価4,800円の、初心者のためのエクセルマクロ動画講座。
  1. Excel 97~Excel 2016まですべて対応。動画本数20本、総再生時間2時間44分53秒
  2. PC, Mac, iPhone, iPad, Androidのお好みの環境で、いつでも好きなときに学べます。
2004年から10年間述べ3,000名以上に実施した研修の経験と実績を集約した講座です。
いますぐ無料で試してください。

トップへ