自力でプログラムを書いてみる

はじめに

　プログラミングが出来るようになるためには、とにかくコードを書いて試してみる事です。
　Excelの業務改善で良く行われるのは、あるデータを集計したり、抽出したりという作業が多いと思います。
　今回は、サンプルのデータを色々加工する練習をしてみましょう。

　このページで使うデータは、以下からダウンロードできます。標準モジュールにプログラムを書いて練習しましょう。

ある文字列を含むリスト

　ここでは、リストの中からある文字列を含むものを抽出する方法と、そのリストをソートする方法を学びましょう。

ある文字列を含むものを抽出

　やり方は、何通りかありますが、今回はInStr関数を使用してみます。
　InStr関数は、ある文字列の中で検索文字列が何番目に現れるかを返す関数です。
　この時、文字列が含まれていなければ 0 を返します。
　この事を利用すれば、ある文字列に検索文字列が含まれているか判定できます。
　　InStr( 文字列 , 検索文字列 )
　例えば、住所の中から「東京都」を含むものを抽出したい場合は、以下のようにします。
　n= InStr( “東京都渋谷区” , “東京都” )
　n には 1 が返ってきます。もし”東京都” が含まれていなければ 0 が返ってきます。
　
　文字列が含まれているか判断するには、以下のようにします。
　If InStr( myString ,“東京都”)>0 then
　もし、myStringに”東京都”が入っていれば 0 以外の数値が返るので検索文字があるか判断できます。

　以下のような結果となるようなプログラムを書いてみましょう。

作り方

　個人dataシートの住所から「東京都」を含むデータを抽出してください。
　
　今回は読み込みシート（個人data）、書き込みシート(抽出data)をそれぞれ指定したプログラムにします。
　プログラムの構成としては、For文で「個人data」シートを2行目から最終行までループさせます。

　最終行は、以下で得られます。定番の書き方なので覚えましょう。（暗記は不要です。）
　シートオブジェクト.Cells(Rows.Count, 列).End(xlUp).Row
　
　ループの最中にIf文で条件分岐させます。住所だけ検索すれば良いので、Ｆ列の値に対して先程のInStr関数で検索します。
　If InStr(sh.Cells(),”東京都”)>0 then
　
　条件を満足した場合は、抽出dataシートに値を転記していきましょう。
　生年月日は日付なので、書式設定もコピーします。
　書式設定のプロパティは、　Rangeオブジェクト.NumberFormatLocal　でした。
　
　以上の知識からプログラムを組んでみてください。

プログラム例

Sub Macro1()
    Dim dSh As Worksheet
    Dim oSH As Worksheet
    
    Set dSh = Worksheets("個人data")
    Set oSH = Worksheets("抽出data")
    
    Dim i As Long
    Dim cnt As Long
    Dim lastRow As Long
    lastRow = dSh.Cells(Rows.Count, 1).End(xlUp).Row
    
    cnt = 2
    For i = 2 To lastRow
        If InStr(dSh.Cells(i, "F"), "東京都") > 0 Then
            oSH.Cells(cnt, "A") = dSh.Cells(i, "A")
            oSH.Cells(cnt, "B") = dSh.Cells(i, "B")
            oSH.Cells(cnt, "C") = dSh.Cells(i, "C")
            oSH.Cells(cnt, "C").NumberFormatLocal = dSh.Cells(i, "C").NumberFormatLocal
            oSH.Cells(cnt, "D") = dSh.Cells(i, "D")
            oSH.Cells(cnt, "E") = dSh.Cells(i, "E")
            oSH.Cells(cnt, "F") = dSh.Cells(i, "F")
            cnt = cnt + 1
        End If
    Next i
End Sub

　抽出したデータの行数のカウントをする変数( cnt ) を設置できたでしょうか？
　もし、１個づつセルを転記していくのが冗長だと感じるなら、Copyコマンドを使用しても良いでしょう。

　If文の中を以下のように変えます。
　dSh.Range(dSh.Cells(i, “A”), dSh.Cells(i, “F”)).Copy
　oSH.Cells(cnt, “A”).PasteSpecial Paste:=xlPasteAll
　cnt = cnt + 1
　
　もし検索文字を変えて色々試すのであれば、抽出dataシートの値を削除しておく必要があります。
　ここでは省略します。

リストをソート

　リストをソートする方法もたくさんありますが、ここではVBA固有のオートフィルターを使いましょう。
　ソースコードは、「マクロの記録」で書かせてみましょう。

　前のプログラムで抽出したリストを生年月日順に並び変えてみます。

「マクロの記録」でオートフィルターの動きを再現させる

　1.「マクロの記録」を開始します。
　2. “A1:F10″の範囲をドラッグして選択します。
　3. メニューの「データ」から「フィルター」をクリックすると、オートフィルターが適用されます。

　4. C列の生年月日部分をクリックして昇順でソートをかけます。

　5. 最後にもう一度、メニューの「データ」から「フィルター」をクリックしてオートフィルターを解除します。

　出来上がったコードを見てみましょう。

Sub Macro1()
    Range("A1:F10").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("抽出data").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("抽出data").AutoFilter.Sort.SortFields.Add2 Key:= _
        Range("C1:C10"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("抽出data").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Selection.AutoFilter
End Sub

　このまま使用すると、検索結果の件数の増減があると上手くいきませんので、行数をカウントして選択領域を決めるように改造します。

　Range(“A1:F10”)　の部分は、　
　最終行を求めて、lastRow という変数に入れて以下のようにします。
　Range(.Cells(1, “A”), Cells(lastRow, “F”))
　これで検索結果が増減しても選択領域をセットできます。
　
　Range(“A1:F10”).Select
　Selection.AutoFilter

　の部分は、以下のように一行に出来ます。
　Range(“A1:F10”).Selection.AutoFilter
　最終行（lastRow）を適用すると、
　Range(.Cells(1, “A”), Cells(lastRow, “F”)).AutoFilter
　
　また、Range(“C1:C10”) の部分も変更しなければなりません。
　10 部分を、最終行（lastRow）に変更すれば良いでしょう。
　
　最後に、Selection.AutoFilter でオートフィルターを解除しています。
　オートフィルターコマンドは、設定した状態の時は解除され、設定されていない時は、オートフィルターがかかるようになっています。
　最後にオートフィルターを解除しておくようにします。
　
　変更したプログラムは以下のようになりました。

Sub MacroSotoFilterSort()
    Dim lastRow As Long
    With ActiveWorkbook.Worksheets("抽出data")
    '最終行を得る
    lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
    
    'データのある領域にオートフィルターを設定
    .Range(.Cells(1, "A"), Cells(lastRow, "F")).AutoFilter
    
    .AutoFilter.Sort.SortFields.Clear
    .AutoFilter.Sort.SortFields.Add2 Key:= _
        .Range(.Cells(1, "C"), Cells(lastRow, "C")), _
        SortOn:=xlSortOnValues, _
        Order:=xlAscending, DataOption:=xlSortNormal
    End With
    
    With ActiveWorkbook.Worksheets("抽出data").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    'オートフィルターの設定を解除
    With ActiveWorkbook.Worksheets("抽出data")
    .Range(.Cells(1, "A"), Cells(lastRow, "F")).AutoFilter
    End With
End Sub

　下線部分が主に変更した所になります。

　Withステートメントの使い方に注意しましょう。
　中段では .Sort まで含まれていますのでこのようにしています。

Macro1の後に呼び出す

　先程書いたMacro1プロシージャの最後に、以下のようにして呼び出すとこで、抽出リストを生年月日順にする事が出来ます。

　MacroSotoFilterSortCall

重複のないリスト

　今度は、売上シートの表で担当者の重複しないリストを作ってみましょう。
　「重複しないリスト」というのはアルゴリズム（問題を解決するための手順）の問題のような部類に入ります。
　VBAで「重複しないリスト」を作る方法はいくつかありまして、辞書クラスや、配列を使った方法などがあります。
　ここではあまり難しい事は考えずにパズルを解くような感覚で挑戦してみましょう。

For文とIf文を使った方法

　効率などは考慮せずに、単純な手続きで実現してみましょう。
　元のリストの他に新しい空のリストを作り、2つのリストを比べながら重複のないリストを完成させていきます。

Sub myMacro2()
    Worksheets("売上").Select
    
    Dim i As Long, j As Long
    Dim lastRow As Long
    Dim flag As Boolean
    Dim cnt As Long
    
    '最終行を得る
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    For i = 2 To lastRow
        flag = False

        '重複なしリストのループ
        For j = 2 To Cells(Rows.Count, "G").End(xlUp).Row
            If Cells(j, "G") = Cells(i, "A") Then '担当者が同じなら
                flag = True
                Exit For
            End If
        Next j
        '重複が無かったので追加
        If flag = False Then
            Cells(j, "G") = Cells(i, "A") 
        End If

    Next i
End Sub

　最初に、Worksheets(“売上”).Select として目的のシートをアクティブにしています。
　こうする事で、その後はRangeオブジェクトから書き始める事ができます。

　さて、このプログラムのキモは、重複の判定用に 変数flag を使っている点です。
　これまでに無い値であれば、新たに追加されますが、その時に内部のループの最終値が更新されていきます。
　Exit For に関しては無くても動作しますが、既に同じものがあるのに更に探索を続けるのは無意味なのでFor文を抜けるようにしています。

Excelの「重複の削除」を使う

　別の方法を試してみましょう。
　Excelに「重複の削除」というコマンドがありますので、「マクロの記録」を使ってコードを見てみましょう。
　1. A列のデータ部分をそっくりG列にコピーします。
　2. 「マクロの記録」を起動します。
　3. G列のデータが選択された状態のまま、「データ」から「重複の削除」を実行してください。
　4. メッセージが何度か出ますが、全て「OK」で抜けます。
　5.「記録終了」で終了します。
　
　コードを見てみましょう。

Sub Macro2()
    Range("G2:G20").Select
    Application.CutCopyMode = False
    ActiveSheet.Range("$G$2:$G$20").RemoveDuplicates Columns:=1, Header:=xlNo
End Sub

　一行目は、G列のデータ部分のセレクト
　二行目は、コピーモードを抜けています。（クリップボードにある値をクリア）
　三行目が重複削除のコマンドのようです。
　Rangeの範囲を調整すれば良さそうなので、A列からコピーする所から書くと以下のようになります。

Sub myMacro3()
    Worksheets("売上").Select
    '最終行を得る
    Dim lastRow As Long
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    'G列へコピー
    Range(Cells(2, "A"), Cells(lastRow, "A")).Copy
    Range("G2").PasteSpecial Paste:=xlPasteAll
    '重複の削除
    Range(Cells(2, "G"), Cells(lastRow, "G")).RemoveDuplicates Columns:=1, Header:=xlNo
End Sub

　結構簡単に実現できました。

各担当者の売上金額合計を表示

　担当者の重複のないリストができましたので、各担当者の売上金額合計を表示させてみましょう。

Sub myMacro4()
    Worksheets("売上").Select

    '前の値が残っていたら消す
    Range("G2:H20").ClearContents

    Call myMacro2   '重複のないリスト
    
    Dim i As Long, j As Long
    Dim total As Long
    
    For i = 2 To Cells(Rows.Count, "G").End(xlUp).Row
        For j = 2 To Cells(Rows.Count, "A").End(xlUp).Row
            If Cells(i, "G") = Cells(j, "A") Then
                Cells(i, "H") = Cells(i, "H") + Cells(j, "D")
            End If
        Next j
    Next i

End Sub

　For文を二重にするだけなのでそれほど難しくないと思います。
　最初に、目的のシートを選択しているので、シートオブジェクトを気にしないで書けます。
　前の値があったら消しておくようにします。

2つのデータから請求書を作成

　以下のような顧客情報と売上表から、請求書を作成するプログラムを書いてみましょう。

　表は単純ですが、このようなケースのプログラムは良く使いますので、基本的な作り方をマスターしましょう。

作り方

　今回使うシートは上から、
　・個人data シート
　・売上 シート
　・請求書 シート
　となっています。
　プログラムの動作としては、請求書シートのA1セルにID番号を入力すると、個人dataシートの「ID」から氏名、郵便番号、住所を抽出し、さらに、売上シートの「請求先」(E列)から該当する値を抽出するというものです。
　プログラム例を示しますが、是非、自分でプログラムを組んでみてください。
　以下の点に注意しながら作ってみましょう。
　・このプログラムは、3つのシートを行き来しますので、それぞれシートオブジェクトを用意します。
　・請求書のIDが入れ替わった時に、前の値が残らないように初期化するようにします。
　・氏名を転記する時、名前の最後に敬称（様）を付けるようにしましょう。
　・日付が 「7月8日」という表記から「7/8」という表記に変わっています。※
　・合計金額は、セルに数式がありますので、プログラムは不要です。

　※　Format( セル , “m/d”) とします。

考え中,,,

プログラムソース

　プログラム例です。全く同じにならなくても同じように動作すればOKです。

Sub myMacro5()
    Worksheets("請求書").Select
    '初期化
    Range("B2:B3, B5, B8:D15").ClearContents

    Dim i As Long, cnt As Long
    Dim ws As Worksheet
    Set ws = Worksheets("個人data")
    Dim uSh As Worksheet
    Set uSh = Worksheets("売上")
    
    '氏名、郵便番号、住所
    For i = 2 To ws.Cells(Rows.Count, 1).End(xlUp).Row
        If Range("A1") = ws.Cells(i, "A") Then    'ID
            Range("B2") = ws.Cells(i, "E")
            Range("B3") = ws.Cells(i, "F")
            Range("B5") = ws.Cells(i, "B") & " 様"
            Exit For
        End If
    Next i
    '請求
    cnt = 8
    For i = 2 To uSh.Cells(Rows.Count, 1).End(xlUp).Row
        If Range("A1") = uSh.Cells(i, "E") Then   
            Cells(cnt, "B") = Format(uSh.Cells(i, "B"), "m/d")           
            Cells(cnt, "C") = uSh.Cells(i, "C")
            Cells(cnt, "D") = uSh.Cells(i, "D")
            cnt = cnt + 1
        End If
    Next i
End Sub

　まず、ワークシートオブジェクトですが、請求書シートはSelectしてアクティブシートにしています。個人dataシートと売上シートは、それぞれ変数に取っています。

　続いて初期化ですが、ClearContentsでセルをクリアしますが、Rangeの指定が見慣れませんね。
　Range(“B2:B3, B5, B8:D15”).ClearContents
　このように書くと、B2:B3 ＋ B5 ＋ B8:D15 それぞれが範囲していされます。
　必ず1つの文字列として書かなければいけません。

　次は、個人dataシートからIDを検索して、名前、郵便番号、住所を転記します。
　最後の Exit For は書けたでしょうか？お目当ての値が見つかったらFor文を抜けましょう。

　最後に請求書シートの請求先で検索して、値を転記していきます。
　こちらは、カウント用の変数 cnt を使って転記する行を決めています。
　こちらは先後まで検索しなければいけないので、Exit For は書きません。

　日付部分の転記はFormat関数を使って以下のように書きます。
　Cells(cnt, “B”) = Format(uSh.Cells(i, “B”), “m/d”)
　Format関数の詳細について以下のページを参照してください。
　・Format関数

　最終行を取得するコードはこの手のプログラムでは定番ですので、使えるようにしましょう。

イベントプロシージャで実行させる

　今回は、イベントプロシージャを使い、請求書シートのA1セルにIDが入力されるとプログラムを実行するようにしてみましょう。

　仕組みとしては、セルの変更を監視している、Worksheet_Change というイベントプロシージャから今回書いたプロシージャを呼び出します。

イベントプロシージャの使い方

　イベントプロシージャは標準モジュールに書くのではなく、各シートモジュール、またはThisworkbookモジュールに書きます。

　今回は、請求書シートのイベントを拾うので請求書シートモジュールをダブルクリックして開きます。

　コードウインドウの上部に、2つのドロップボックスが出ますので、
　右をWorksheet、左をChangeを選択します。
　すると、以下のようにプロシージャが勝手に書かれます。

　下の Worksheet_SelectionChange は不要なので消してしまって構いません。
　上の Worksheet_Change に以下のプログラムを書きます。

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A1")) Is Nothing Then
        Exit Sub
    End If
    
    Call myMacro5
End Sub

プログラム解説

　まず、最後の　Call myMacro5 は今回書いたプロシージャを呼び出している部分です。
　上の　If Intersect(Target, Range(“A1”)) Is Nothing Then　がここでのキモです。
　
　Intersect は引数のRange範囲の重なった部分を返す関数になります。
第一引数の Target は Worksheet_Change の引数になっていますね。Worksheet_Change はセルに変更があると、変更されたセルを Target に入れて呼び出されます。
第二引数には、今回変更した時にプログラムを起動したいA1セルを指定して、2つの範囲を比べています。
　Intersect は結果として、重なる範囲があれば、そのRangeを、重なる範囲が無ければ Nothing を返すので、If文では、それを判定します。
　Intersect の詳細は以下を参照してください。
　・セルの重なった部分を返す Intersect

　つまりここでは、A1セルが変更されたかを判断しているのです。
　もし、A1セルが変更されていなければ、Exit Sub としてプログラムを終了しています。

　請求書シートのA1を変更するたびにプログラムが実行されて請求書の内容が変化するはずです。

まとめ

　今回のコードは初心者の方には難しく感じたかもしれません。
　ただ、何回もプログラムを書いていると同じような書き方が何度も出てくるのがわかると思います。
　
　プログラムをパーツを組み合わせる感じで認識できるようになれば、ネット上のサンプルコードを利用できるようになるでしょう。
　
　また、今回は「マクロの記録」を改造していく方法を紹介しました。
　慣れてくれば、どこを変更すれば良いか分かるようになってくると思います。
　様々なプロパティやオプションが出てきますが、検索サイトで調べればすぐに見つける事ができるでしょう。

　今回は、定番とされる処理がいくつか出てきましたので、以下にまとめておきます。
　これらは、暗記しなくても良いので、使い方を覚えるようにしましょう。

よく使う処理

　・文字列に検索文字列が含まれているか判断
　If InStr( 文字列 , 検索文字列 )>0 then

　・ある列の最終行を得る
　最終行 = シートオブジェクト.Cells(Rows.Count, 列).End(xlUp).Row

　・最終行からRangeを得て、コピーする例
　Range(Cells(2, “A”), Cells(lastRow, “A”)).Copy
　Range(“G2”).PasteSpecial Paste:=xlPasteAll

　・セルのクリアー
　Range(“G2:H20”).ClearContents

　・Format関数
　Format( セル , 書式 )