第３回 #VBAの悩みはVBAerに聞け に登壇させてもらいます！

はじめに

どうも初めまして、こんぺ と申します。

突然ですがこの度、TwitterのVBAクラスタ界隈で話題になっている「#VBAの悩みはVBAerに聞け」という勉強会に登壇させていただくことになりました！

「VBAの悩みはVBAerに聞け」とは？

こちらの勉強会は、かずやん 様（＠y8bV4ty1wbkTjPd）が作った「#VBAの悩みはVBAerに聞け」のハッシュタグがきっかけとなり生まれた勉強会となっており、
しゃあ 様( @vba07529852 )が主催されてます。

#VBAの悩みはVBAerに聞け
第３回開勉強会 on Zoom 催決定！
1月23日(土) 20時開宴

登壇いただくのは こんぺ(msj)さん！
5年前に作成したものと最近作成したものを2点ご紹介いただきます。https://t.co/j2Xd7ABGQC

チェケラ！

— しゃあ＠やっぱりVBAが好き (@VBA07529852) January 17, 2021

「#VBAの悩みはVBAerに聞け」というハッシュタグに関して、松田軽太 様が投稿された記事がとても分かりやすくまとめられています。
気になる方は是非ご一読ください。

www.matudakta.com

また、どのようなことを過去の勉強会ではどのようなことをやったかについては、様々な方が記事にされています。こちらもぜひご一読ください。

note.com

note.com

そんなこんなで勉強会に向けてしゃあ様とやり取りする中、「勉強会で使うコードを公開してはどうでしょうか？」とご提案いただき、本ブログ記事を書いております。

「はじめてのマクロ」を作るに至った経緯

私の勤め先では、車通勤する社員に対し、会社に免許書や車検証など各証書のコピーを提出するという社内ルールがあります。

そして期限間近になると対象者に書類提出を促すための周知文書を作成する必要があり

1. 提出書類ごとに期限間近の対象者を支店ごとにリストアップ
2. 期限切れの社員はまとめて別項目にリストアップ
3. この２つのリストを所定の様式（見た目）に加工

という至極単純なルーティーンが毎月あります。

5年前、入社したばかりでこのような簡単な業務をいろいろ振られていました。

ですが、半年後には
「この業務、面倒くさいし、ちょいちょいミスる、どうにかならんかExcelよ (´・ω・｀)」
となっていました。

その時、大学講義で１度だけ触れたに「VBA」が頭をよぎり、「自動化で楽できるんじゃね？」と思い立ち…　早速参考書を購入。

参考書とインターネットにあるコードを写経、切り貼りして初めて書いたコードが下のものになります。

勉強会で用いるコード

※1　実際のコードとは一部標記を修正しています。
※2　Excelシートの画像については身バレの可能性が高くなることを憂慮し掲載しておりません。ご容赦ください。

Option Explicit

Sub UpDateReport()
    Dim i As Long, j As Long, k As Long, l As Long, m As Long, n As Long, o As Long, p As Long, q As Long, r As Long, Check(2) As Date, Target(2) As Range, Name As Range, Namber As Range
   
    i = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
    Application.ScreenUpdating = False
    Sheet2.Range(Cells(7, 2), Cells(38, 9)).ClearContents
    Sheet2.Range(Cells(43, 2), Cells(51, 9)).ClearContents
    Sheet2.Range(Cells(43, 2), Cells(51, 9)).Interior.ColorIndex = 2
    
    
    For k = 0 To 2
        l = 7       '本社先頭
        m = 11      'A支店先頭
        n = 19      'B支店先頭
        o = 28      'C支店先頭
        p = 32      'D支店先頭
        q = 43      '期限切れ先頭
        For j = 3 To i
            Check(0) = Sheet1.Cells(j, 5)   '免許証期限
            Check(1) = Sheet1.Cells(j, 7)   '車検証期限
            Check(2) = Sheet1.Cells(j, 9)   '任意保険期限
            Set Target(0) = Sheet1.Cells(j, 5)   '免許証期限
            Set Target(1) = Sheet1.Cells(j, 7)   '車検証期限
            Set Target(2) = Sheet1.Cells(j, 9)   '任意保険期限
            Set Name = Sheet1.Cells(j, 4)
            Set Namber = Sheet1.Cells(j, 14)
            If k = 0 Then
                If Sheet2.Cells(3, 10) > CDbl(Check(k)) Then
                    Name.Copy
                    Sheet2.Cells(q, 2).PasteSpecial (xlPasteValues)
                    Target(k).Copy
                    Sheet2.Cells(q, 3).PasteSpecial (xlPasteValues)
                    q = q + 1
                ElseIf Sheet2.Cells(3, 11) > CDbl(Check(k)) Then
                    If Sheet1.Cells(j, 3).Value = "本社" Then
                        Name.Copy
                        Sheet2.Cells(l, 2).PasteSpecial (xlPasteValues)
                        Target(k).Copy
                        Sheet2.Cells(l, 3).PasteSpecial (xlPasteValues)
                        l = l + 1
                    ElseIf Sheet1.Cells(j, 3).Value = "E支店" Then
                        Name.Copy
                        Sheet2.Cells(l, 2).PasteSpecial (xlPasteValues)
                        Target(k).Copy
                        Sheet2.Cells(l, 3).PasteSpecial (xlPasteValues)
                        l = l + 1
                    ElseIf Sheet1.Cells(j, 3).Value = "A支店" Then
                        Name.Copy
                        Sheet2.Cells(m, 2).PasteSpecial (xlPasteValues)
                        Target(k).Copy
                        Sheet2.Cells(m, 3).PasteSpecial (xlPasteValues)
                        m = m + 1
                    ElseIf Sheet1.Cells(j, 3).Value = "B支店" Then
                        Name.Copy
                        Sheet2.Cells(n, 2).PasteSpecial (xlPasteValues)
                        Target(k).Copy
                        Sheet2.Cells(n, 3).PasteSpecial (xlPasteValues)
                        n = n + 1
                    ElseIf Sheet1.Cells(j, 3).Value = "C支店" Then
                        Name.Copy
                        Sheet2.Cells(o, 2).PasteSpecial (xlPasteValues)
                        Target(k).Copy
                        Sheet2.Cells(o, 3).PasteSpecial (xlPasteValues)
                        o = o + 1
                    ElseIf Sheet1.Cells(j, 3).Value = "D支店" Then
                        Name.Copy
                        Sheet2.Cells(p, 2).PasteSpecial (xlPasteValues)
                        Target(k).Copy
                        Sheet2.Cells(p, 3).PasteSpecial (xlPasteValues)
                        p = p + 1
                    End If
                End If
           
            ElseIf k = 1 Then
                If Sheet2.Cells(3, 10) > CDbl(Check(k)) Then
                    Name.Copy
                    Sheet2.Cells(q, 4).PasteSpecial (xlPasteValues)
                    Target(k).Copy
                    Sheet2.Cells(q, 5).PasteSpecial (xlPasteValues)
                    Namber.Copy
                    Sheet2.Cells(q, 6).PasteSpecial (xlPasteValues)
                    q = q + 1
                ElseIf Sheet2.Cells(3, 11) > CDbl(Check(k)) Then
                    If Sheet1.Cells(j, 3).Value = "本社" Then
                        Name.Copy
                        Sheet2.Cells(l, 4).PasteSpecial (xlPasteValues)
                        Target(k).Copy
                        Sheet2.Cells(l, 5).PasteSpecial (xlPasteValues)
                        Namber.Copy
                        Sheet2.Cells(l, 6).PasteSpecial (xlPasteValues)
                        l = l + 1
                    ElseIf Sheet1.Cells(j, 3).Value = "E支店" Then
                        Name.Copy
                        Sheet2.Cells(l, 4).PasteSpecial (xlPasteValues)
                        Target(k).Copy
                        Sheet2.Cells(l, 5).PasteSpecial (xlPasteValues)
                        Namber.Copy
                        Sheet2.Cells(l, 6).PasteSpecial (xlPasteValues)
                        l = l + 1
                    ElseIf Sheet1.Cells(j, 3).Value = "A支店" Then
                        Name.Copy
                        Sheet2.Cells(m, 4).PasteSpecial (xlPasteValues)
                        Target(k).Copy
                        Sheet2.Cells(m, 5).PasteSpecial (xlPasteValues)
                        Namber.Copy
                        Sheet2.Cells(m, 6).PasteSpecial (xlPasteValues)
                        m = m + 1
                    ElseIf Sheet1.Cells(j, 3).Value = "B支店" Then
                        Name.Copy
                        Sheet2.Cells(n, 4).PasteSpecial (xlPasteValues)
                        Target(k).Copy
                        Sheet2.Cells(n, 5).PasteSpecial (xlPasteValues)
                        Namber.Copy
                        Sheet2.Cells(n, 6).PasteSpecial (xlPasteValues)
                        n = n + 1
                    ElseIf Sheet1.Cells(j, 3).Value = "C支店" Then
                        Name.Copy
                        Sheet2.Cells(o, 4).PasteSpecial (xlPasteValues)
                        Target(k).Copy
                        Sheet2.Cells(o, 5).PasteSpecial (xlPasteValues)
                        Namber.Copy
                        Sheet2.Cells(o, 6).PasteSpecial (xlPasteValues)
                        o = o + 1
                    ElseIf Sheet1.Cells(j, 3).Value = "D支店" Then
                        Name.Copy
                        Sheet2.Cells(p, 4).PasteSpecial (xlPasteValues)
                        Target(k).Copy
                        Sheet2.Cells(p, 5).PasteSpecial (xlPasteValues)
                        Namber.Copy
                        Sheet2.Cells(p, 6).PasteSpecial (xlPasteValues)
                        p = p + 1
                    End If
                End If
                
            ElseIf k = 2 Then
                If Sheet2.Cells(3, 10) > CDbl(Check(k)) Then
                    Name.Copy
                    Sheet2.Cells(q, 7).PasteSpecial (xlPasteValues)
                    Target(k).Copy
                    Sheet2.Cells(q, 8).PasteSpecial (xlPasteValues)
                    Namber.Copy
                    Sheet2.Cells(q, 9).PasteSpecial (xlPasteValues)
                    q = q + 1
                ElseIf Sheet2.Cells(3, 11) > CDbl(Check(k)) Then
                    If Sheet1.Cells(j, 3).Value = "本社" Then
                        Name.Copy
                        Sheet2.Cells(l, 7).PasteSpecial (xlPasteValues)
                        Target(k).Copy
                        Sheet2.Cells(l, 8).PasteSpecial (xlPasteValues)
                        Namber.Copy
                        Sheet2.Cells(l, 9).PasteSpecial (xlPasteValues)
                        l = l + 1
                    ElseIf Sheet1.Cells(j, 3).Value = "E支店" Then
                        Name.Copy
                        Sheet2.Cells(l, 7).PasteSpecial (xlPasteValues)
                        Target(k).Copy
                        Sheet2.Cells(l, 8).PasteSpecial (xlPasteValues)
                        Namber.Copy
                        Sheet2.Cells(l, 9).PasteSpecial (xlPasteValues)
                        l = l + 1
                    ElseIf Sheet1.Cells(j, 3).Value = "A支店" Then
                        Name.Copy
                        Sheet2.Cells(m, 7).PasteSpecial (xlPasteValues)
                        Target(k).Copy
                        Sheet2.Cells(m, 8).PasteSpecial (xlPasteValues)
                        Namber.Copy
                        Sheet2.Cells(m, 9).PasteSpecial (xlPasteValues)
                        m = m + 1
                    ElseIf Sheet1.Cells(j, 3).Value = "B支店" Then
                        Name.Copy
                        Sheet2.Cells(n, 7).PasteSpecial (xlPasteValues)
                        Target(k).Copy
                        Sheet2.Cells(n, 8).PasteSpecial (xlPasteValues)
                        Namber.Copy
                        Sheet2.Cells(n, 9).PasteSpecial (xlPasteValues)
                        n = n + 1
                    ElseIf Sheet1.Cells(j, 3).Value = "C支店" Then
                        Name.Copy
                        Sheet2.Cells(o, 7).PasteSpecial (xlPasteValues)
                        Target(k).Copy
                        Sheet2.Cells(o, 8).PasteSpecial (xlPasteValues)
                        Namber.Copy
                        Sheet2.Cells(o, 9).PasteSpecial (xlPasteValues)
                        o = o + 1
                    ElseIf Sheet1.Cells(j, 3).Value = "D支店" Then
                        Name.Copy
                        Sheet2.Cells(p, 7).PasteSpecial (xlPasteValues)
                        Target(k).Copy
                        Sheet2.Cells(p, 8).PasteSpecial (xlPasteValues)
                        Namber.Copy
                        Sheet2.Cells(p, 9).PasteSpecial (xlPasteValues)
                        p = p + 1
                    End If
                End If
            End If
            Application.CutCopyMode = False
        Next
            
    Next
    Application.ScreenUpdating = True
    Application.CutCopyMode = False
    
End Sub

その後

このコードを書き上げ、30分くらいかかっていた作業がワンクリックで終わるようになると、そこにひとりのVBAerが誕生していました。
そのVBAerはすっかり気をよくして、手の届く業務範囲で自動化を押しすすめ、身の丈に合わない依頼を引き受け盛大にズッコケたりしました。

…そんなこんなで時は５年たち、まさかのVBA勉強会に無謀にも立候補。

公開できるよう一部修正するため、５年前に自身が書いた渾身のコードを読み返すことに…

（　＾ω＾）・・・

無駄に長ぇなぁオイ！(# ﾟДﾟ)

まぁ。プログラミングの基本や作法も全然わかっていないときに書いたコードなので、いろいろとご容赦ください…

というわけで、当初の内容から少し変わって

↓　のようになりました！

第3回のイベント内容に異変が！！
なんとなんと！

リアルタイム リファクタリング！

過去作プログラムを、機能を変更せずにより洗練されたコードに再構築！
他人の生のコーディングを見られる機会なんてめったにないぞ！

Don't miss it！#VBAの悩みはVBAerに聞け https://t.co/LGTyGqZBNO

— しゃあ＠やっぱりVBAが好き (@VBA07529852) 2021年1月19日

この無駄に長いコードを無謀にも生リファクタリング！

５年でいろいろズッコケたおかげでスキルアップしている…はずですが、あまり期待はしないでください…

その他話題にしたいなぁ…と漠然と思っていることは

• 今の自分がこの作業を改めて自動化するならどうするか
• 「自分で使うマクロ」と「人に使ってもらうマクロ」を組む時に考えていること

など「プログラミングの考え方」や「VBAをつかった業務改善」のことなどをメインとしてVBAerの皆様と意見交換できればいいなぁ、と考えております。

VBA勉強会「VBAの悩みはVBAerに聞け」は
2021年1月23日　20時頃から
どうぞよろしくお願いいたします！