ファビコン。井の家紋。エクセルマクロの基本(初級)その3 | エクセルマクロ(VBA)実践蔵(じっせんぐら)

前の項目 - エクセルマクロの基本(初級)その2
次の項目 - 2ブックの表を照らし合わせて更新するマクロのテンプレート

エクセルマクロの基本(初級)その3最終更新日:2023-06-17

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

エクセル関数の代表「=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を使いこなせれば、ある程度のことはできるかと思います。どんなに書き慣れていても、関数の使い方をすべて覚えているわけではありません。都度、ネットで関数の仕様などを調べながら書くのが普通です。なので、細かい部分は調べながらやりたいことを進めてください。

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

前の項目 - エクセルマクロの基本(初級)その2
次の項目 - 2ブックの表を照らし合わせて更新するマクロのテンプレート