エクセルマクロの基本（初級）その３ | エクセルマクロ(VBA)実践蔵(じっせんぐら)

トップ項目一覧

• 関連記事
• エクセルマクロの基本（初級）その１
• エクセルマクロの基本（初級）その２

上の記事からのつづきになります。ずっと、シートオブジェクトに記述して説明をしてきたため、記述場所を変えた場合の書き方の違いについて書いていこうと思ったのですが、その前に関数について説明しておきます

エクセル関数の代表「=SUM("A1:A10")」で説明すると、()内は、引数と呼ばれ、計算結果は、戻り値と呼びます。コードをだらだら書いていくと長くなるため、関数化させて見やすくかく必要があります。

その関数を書くためにおすすめの場所は、標準モジュールになります。

プロジェクトエクスプローラ上で右クリックして、「挿入」を選ぶと、標準モジュールを選ぶことができます。

標準モジュールに関数を記述すると、そのエクセルファイル内であればどこからでも関数名だけで呼び出すことができます。エクセル関数のようにセルから呼び出すことも可能です。

対して、シートオブジェクトに関数を記載した場合は、別の場所からその関数を呼び出そうとする場合、どこに記述した関数かを指定する必要があります。

なので、標準モジュールに関数を作成して、書き方の違いについてコードを使って説明していこうと思います。

標準モジュールにコードを開く

 
Function WriteShtSimple(SheetName As String) As Boolean 
 
    '変数宣言 WorkSheet型オブジェクト 
    Dim wSheet As Worksheet 
 
    '引数のSheetNameのシートが存在する前提 
    'なければエラーになる 
    Set wSheet = Worksheets(SheetName) 
         
    '指定されたシートのセルA1 
    If wSheet.Range("A1").Value = "" Then 
        wSheet.Range("A1").Value = "テストだよ" 
         
        '戻り値にTrueを設定する 
        WriteShtSimple = True 
    Else 
        '戻り値にFalseを設定する 
        WriteShtSimple = False 
    End If 
     
    'メモリ解放 
    Set wSheet = Nothing 
     
End Function 

引数でシート名を受け取りそのシートのセルA1を読んで、空欄であれば書き込みをして、Trueを返し、セルA1に何か記入されていたら書き込まないでFalseを返すという関数になります。

シートが存在しない場合の対処を入れていないので、存在するシート名を受け取ることが前提です。

関数の書き方として、戻り値を返す関数は、Functionにします。Sub関数は戻り値を返せません。

関数名の後ろの()内に受け取る引数が入ります。()の外、右側のAs Booleanは戻り値の型になります。

BooleanはTrue/Falseを返すことができる型です。オブジェクトではなく、StringやLongの仲間です。

（オブジェクトの変数に値を設定するには、Setが必要ですが、文字列や数値、Booleanには不要です。）

戻り値を返すには、関数名を変数のように使用します。

関数内で、関数名に対して、True/Falseを設定しています。

シートオブジェクト(VBAコードを記述する場所)でRange("A1")と記述すると、そのシートのA1セルをさします。標準モジュールでRange("A1")と記述すると一番正面に表示されているシートが対象になります。(ActiveSheetが対象になる。)開いているシートによってマクロの動きが変わるのはあまりよくないので、必ずシートオブジェクト型変数か、WorkSheets("シート名")という記述を使用して、どのシートのどのセルに書きたいのかを記述する必要があります。

この関数内で、セルA1にアクセスする場合は、シートオブジェクト型変数を使用して、「wSheet.Range("A1").Value」と記述しています。この書き方で、どのシートのセルにアクセスしたいのかが指定できます。

この関数を呼び出してみましょう。呼び出すのは、シートオブジェクト(VBAコードを記述する場所)からでも、標準モジュールに記述しても問題ありません。

 
Sub FncTest() 
     
    Dim rslt As Boolean 
     
    '自作の関数を呼び出すよ 
    rslt = WriteShtSimple("Sheet1") 
     
    '結果をチェック 
    If rslt = True Then 
        MsgBox "かけたよ" 
    Else 
        MsgBox "何か書いてあったよ" 
    End If 
 
End Sub 

WriteShtSimpleの引数には存在するシート名を指定してください。存在しないシートではエラーになります。

WriteShtSimple関数内で、空欄であれば書き込んでいて、何か書いてあればFalseを返すため、実行1回目と2回目で動作が変わります。

関数に戻り値がある場合は、「変数 = 関数(引数)」 の形になりますが、ない場合は、「Call 関数(引数)」と記述する必要があります。Sub関数を呼び出す場合は、戻り値がないので、かならず頭にCallが必要です。戻り値を返す関数で、必ず戻り値を受け取らなければいけないわけではありません。今回も戻り値による分岐をしない場合は、「Call WriteShtSimple("Sheet1")」で呼び出すこともできます。

関数についての補足になりますが、標準モジュールに記述する関数はこのエクセルブック内であれば、関数名だけで上記のように呼び出せます。しかし、シートオブジェクト(VBAコードを記述する場所)に関数を書いて、それを標準モジュールから呼び出そうとする場合、「WorkSheets("シート名").関数名」のように、シートオブジェクト型にピリオド「.」をつけて呼び出す必要があります。

別ブックを開くマクロ

次は、Workbookオブジェクトの使い方です。本来パスを取得するには、ファイル参照ダイアログやフォルダ参照ダイアログを出して、パスを取得することを推奨しますが、WorkBookオブジェクトを扱う練習コードということで、今回は、使っていません。ファイル参照ダイアログやフォルダ参照ダイアログを使ってみるとより、ツールっぽくなります。

• 関連記事
• ファイル参照-ファイル選択ダイアログ
• フォルダ参照-フォルダ選択ダイアログ

ひきつづき、標準モジュールに記述するコードです。

 
 
Sub OpenBookTest() 
     
    Dim FileName As String 
    Dim path As String 
    Dim Wbk As Workbook 
    Dim Wsht As Worksheet 
     
    FileName = "テスト.xlsx" 
     
    'ThisWorkbook.pathは、マクロ有効ブックの格納フォルダパス 
    'そのpathと開くファイル名を連結させる 
    path = ThisWorkbook.path & "/" & FileName 
     
    If Dir(path) <> "" Then 
    'ファイルが存在する場合 
        Set Wbk = Workbooks.Open(path) 
    Else 
    'ファイルが存在しない場合 
        'ファイルを新規追加 
        Set Wbk = Workbooks.Add 
        'ファイル名をつけて保存 
        Wbk.SaveAs (path) 
         
    End If 
     
    'ブック内のシート数分でループ 
    For Each Wsht In Wbk.Worksheets 
        'Sheet1があるか確認 
        If Wsht.Name = "Sheet1" Then 
             
            'Sheet1のセルA1に書き込む 
            Wsht.Range("A1").Value = "書き込むよ" 
             
            MsgBox "Sheet1を見つけたよ" 
             
            Exit For 
        End If 
    Next 
     
    '開いたブックを保存して閉じる 
    Wbk.Close SaveChanges:=True 
     
    'メモリ解放 
    Set Wbk = Nothing 
    Set Wsht = Nothing 
     
End Sub 

上のコードは、マクロ有効ブックと同階層に「テスト.xlsx」というファイル名のエクセルが存在するかを確認して、存在する場合は、そのファイルを開きます。なければ新規作成して名前をつけて保存しています。

そして、ブック内のシート数でループを行い、見つけたらセルA1に書き込みを行って、保存して閉じるという処理をしています。

書き換えが必要な場所を探して書き換える

下記の記事で利用した表を、また使用してみましょう。

• 関連記事
• エクセルマクロの基本（初級）その２

上記のような表があったとして、「赤鬼」の「住所」を書き換えていきたいと思います。

 
Sub OpenBookTest2() 
     
    Dim FileName As String 
    Dim path As String 
    Dim Wbk As Workbook 
    Dim Wsht As Worksheet 
     
    '変数宣言 
    Dim Rng As Range 
    Dim NameColRng As Range 
    Dim 住所列数Lg As Long 
    Dim 名前列数Lg As Long 
     
    FileName = "テスト.xlsx" 
     
    'ThisWorkbook.pathは、マクロ有効ブックの格納フォルダパス 
    'そのpathと開くファイル名を連結させる 
    path = ThisWorkbook.path & "/" & FileName 
     
    If Dir(path) <> "" Then 
    'ファイルが存在する場合 
        Set Wbk = Workbooks.Open(path) 
    Else 
    'ファイルが存在しない場合 
        MsgBox "ファイルが開けませんでした。" 
        Exit Sub 
    End If 
     
    'ブック内のシート数分でループ 
    For Each Wsht In Wbk.Worksheets 
        'Sheet1があるか確認 
        If Wsht.Name = "Sheet1" Then 
             
            '変数を初期化 
            住所列数Lg = 0 
            名前列数Lg = 0 
             
            'データが入っている一番上の行 
            For Each Rng In Wsht.Range(Wsht.UsedRange.Rows(1).Address) 
                If Rng.Value = "住所" Then 
                    '住所と一致する場合 
                    住所列数Lg = Rng.Column 
                ElseIf Rng.Value = "名前" Then 
                    '名前と一致する場合 
                    名前列数Lg = Rng.Column 
                End If 
                If 住所列数Lg > 0 And 名前列数Lg > 0 Then 
                    '両方見つけたら、ループ終了 
                    Exit For 
                End If 
            Next 
             
            'Set Rng = Wsht.UsedRange.Find("赤鬼") 
            'Debug.Print "探す範囲は、" & Wsht.UsedRange.Address 
             
            For Each NameColRng In Wsht.UsedRange.Columns 
                If NameColRng.Column = 名前列数Lg Then 
                    '名前列数Lgと列数が一致したら 
                    Exit For 
                End If 
            Next 
             
            '一致した列があれば 
            If Not NameColRng Is Nothing Then 
                'Find関数で探す 
                Set Rng = NameColRng.Find("赤鬼") 
                Debug.Print "探す範囲は、" & NameColRng.Address 
            End If 
             
            'Find関数で見つかった、かつ、住所の列数を特定済みなら 
            If Not Rng Is Nothing And 住所列数Lg > 0 Then 
                     
                Wsht.Cells(Rng.Row, 住所列数Lg).Value = "別ブックからの遠隔操作！" 
                MsgBox "書き換え成功！" 
            Else 
                 
                MsgBox "書き換え失敗！" 
             
            End If 
                 
                Exit For 
            End If 
        Next 
 
 
    '開いたブックを保存して閉じる 
    Wbk.Close SaveChanges:=True 
     
    'メモリ解放 
    Set Wbk = Nothing 
    Set Wsht = Nothing 
    Set Rng = Nothing 
    Set NameColRng = Nothing 
     
End Sub 

前の記事でシートオブジェクトに記述したLoopTest5()と比較すると UsedRangeやRange()の前に、シートオブジェクト型の変数Wshtがつきました。

その部分が、シートオブジェクトにコードを記述して、自分のシートにアクセスする場合と、別シートにアクセスする場合の違いになります。

ファイルが存在しない場合は、Sub関数を終了させました。

For ループ内で移動するRange型変数は、そのままになります。Range型変数からシート名を取得はできませんが、どのシートのセル情報にアクセスしたいのかの情報は持っています。

下記は、シートオブジェクトを引数に関数化したものです。新しい関数名を「ReWriteRange」として、切り分けています。

 
Sub OpenBookTest3() 
     
    '変数宣言 
    Dim FileName As String 
    Dim path As String 
    Dim Wbk As Workbook 
    Dim Wsht As Worksheet 
    Dim Result As Boolean 
     
    FileName = "テスト.xlsx" 
     
    'ThisWorkbook.pathは、マクロ有効ブックの格納フォルダパス 
    'そのpathと開くファイル名を連結させる 
    path = ThisWorkbook.path & "/" & FileName 
     
    If Dir(path) <> "" Then 
    'ファイルが存在する場合 
        Set Wbk = Workbooks.Open(path) 
    Else 
    'ファイルが存在しない場合 
        MsgBox "ファイルが開けませんでした。" 
        Exit Sub 
    End If 
     
    'ブック内のシート数分でループ 
    For Each Wsht In Wbk.Worksheets 
        'Sheet1があるか確認 
        If Wsht.Name = "Sheet1" Then 
             
            Result = ReWriteRange(Wsht) 
             
            Exit For 
        End If 
    Next 
     
    If Result = True Then 
        MsgBox "書き換え成功！" 
    Else 
        MsgBox "書き換え失敗！" 
    End If 
     
    '開いたブックを保存して閉じる 
    Wbk.Close SaveChanges:=True 
     
    'メモリ解放 
    Set Wbk = Nothing 
    Set Wsht = Nothing 
     
End Sub 

 
Function ReWriteRange(WSheet As Worksheet) As Boolean 
     
    '変数宣言 
    Dim Rng As Range 
    Dim NameColRng As Range 
    Dim 住所列数Lg As Long 
    Dim 名前列数Lg As Long 
     
    '変数を初期化 
    住所列数Lg = 0 
    名前列数Lg = 0 
     
    'データが入っている一番上の行 
    For Each Rng In WSheet.Range(WSheet.UsedRange.Rows(1).Address) 
     
        If Rng.Value = "住所" Then 
            '住所と一致する場合 
            住所列数Lg = Rng.Column 
        ElseIf Rng.Value = "名前" Then 
            '名前と一致する場合 
            名前列数Lg = Rng.Column 
        End If 
         
        If 住所列数Lg > 0 And 名前列数Lg > 0 Then 
            '両方見つけたら、ループ終了 
            Exit For 
        End If 
    Next 
     
    'Set Rng = WSheet.UsedRange.Find("赤鬼") 
    'Debug.Print "探す範囲は、" & WSheet.UsedRange.Address 
     
    For Each NameColRng In WSheet.UsedRange.Columns 
        If NameColRng.Column = 名前列数Lg Then 
            '名前列数Lgと列数が一致したら 
            Exit For 
        End If 
    Next 
     
    '一致した列があれば 
    If Not NameColRng Is Nothing Then 
        'Find関数で探す 
        Set Rng = NameColRng.Find("赤鬼") 
        Debug.Print "探す範囲は、" & NameColRng.Address 
    End If 
     
    'Find関数で見つかった、かつ、住所の列数を特定済みなら 
    If Not Rng Is Nothing And 住所列数Lg > 0 Then 
             
        WSheet.Cells(Rng.Row, 住所列数Lg).Value = "関数から書き変えるよ！" 
        ReWriteRange = True 
        'MsgBox "書き換え成功！" 
    Else 
        ReWriteRange = False 
        'MsgBox "書き換え失敗！" 
    End If 
     
    'メモリ解放 
    Set Rng = Nothing 
    Set NameColRng = Nothing 
End Function 

新しい関数「ReWriteRange(引数シートオブジェクト変数)」は、呼び出し元(OpenBookTest3())から渡されるシートオブジェクトに対して、書き換え場所を見つけて書き換えています。呼び出し元でシート毎にループして呼び出したり、エクセルブックを変えて呼び出すことができます。複数のシートで同じことをしたい場合には、関数化させて呼び出します。

これで、初級は終了にしたいと思います。あとは、StrCompやInStr、Replaceを使いこなせれば、ある程度のことはできるかと思います。どんなに書き慣れていても、関数の使い方をすべて覚えているわけではありません。都度、ネットで関数の仕様などを調べながら書くのが普通です。なので、細かい部分は調べながらやりたいことを進めてください。

この続きのような記事を下記に記述しました。良ければこちらも読んでみてください。

• 関連記事
• ２ブックの表を照らし合わせて更新するマクロ