はじめに
他のブックや他のシートを参照するには、それらを指定する必要がありますが、そのままですとプログラムが冗長になりがちで、見通しが悪くなってしまいます。
それのため、実際のプログラムでは、これらの参照が短くなるように工夫して使います。
With ステートメント
VBAでは、Withステートメントを使用して、それ以下のオブジェクトの記述を省略する事ができます。
Withステートメントを使用したら、最後は必ず End With で閉じなければいけません。
With Worksheets("Sheet1")
.Range("A1") = "文字列"
.Range("B2") = 10
Range("C3") = 12 ’.(ドット) が無いのでアクティブシートが対象となる
End With
このコードでは、Range(“A1”) と Range(“B2”) は、Sheet1のセルを指します。
Range(“C3”) はドットが付いていないので、Activesheet が省略されたものと見なされます。
このように、With ステートメントが適用されるのは . (ドット)から始まる文だけです。
ドットが無い場合は、適用されません。
With Worksheets("Sheet1")
Range("B2") = .Range("B2")
End With
上の例では、Sheet1のB2セルの値を、アクティブシートのB2セルに転記しています。
少々見分けずらいのが難点と言えます。
オブジェクト変数
ブックやシートをオブジェクト変数に入れてしまえば、データをやり取りする際に見通しが良くなります。
ブックは、Workbook型。 シートは、Worksheet型がそれぞれありますが。
どちらもObject型から派生しているので、Object型で宣言してもOKです。
(値を代入した時に型が決定されます。)

オブジェクト変数への代入の際は Set を付けなければいけません。
Dim wb As Workbook
Dim sh As Worksheet
Set wb = Workbooks(2) '2番目に開いたブックをセット
Set sh = ThisWorkbook.Worksheets("Sheet1")
sh.Range("A22") = wb.Worksheets("Sheet2").Range("C2")
ブックとシートを変数に置き換えて参照しています。
Dim ws As Object
Set ws = Worksheets("Sheet1")
ws.Range("B22") = 10
Object型に置き換えても問題ありません。
オブジェクトを変数に入れて使う効用
他のシートや他のブックとのデータをやり取りする場合、シートやブックを変数に置き換える事で見通しが良くなります。
複雑なプログラムなればなるほど、簡略化された書き方をした方が、処理の流れを把握しやすくなり便利です。
プログラミング例
これまでの内容で、他のブック、シートにあるセルに自由にアクセスできるようになりました。
さらに、「ブックを開く」、「新たなシートを作る」など、あらたな手法を重ねていけば、実用的なツールに近付いていくでしょう。
ここでは形として紹介しておきますので、詳しい内容はリンクを参照してみてください。
課題:別シートに値を転記
「中村」さんのデータを別シート(data)に転記する。

'別シートに値を転記
Sub Macro10()
Dim ws1 As Worksheet
Dim dSh As Worksheet
Set ws1 = Worksheets("Sheet1")
Set dSh = Worksheets("data")
Dim i As Long
Dim cnt As Long
Dim lastRow As Long
'最終行を取得
lastRow = ws1.Cells(Rows.Count, 1).End(xlUp).row
'dataシート全体をクリアする
dSh.Cells.ClearContents
Dim mName As String
mName = "中村"
dSh.Range("A1") = mName
cnt = 2
For i = 2 To lastRow
If ws1.Cells(i, "A") = mName Then
dSh.Cells(cnt, "B") = ws1.Cells(i, "B")
dSh.Cells(cnt, "B").NumberFormatLocal = ws1.Cells(i, "B").NumberFormatLocal
dSh.Cells(cnt, "C") = ws1.Cells(i, "C")
dSh.Cells(cnt, "D") = ws1.Cells(i, "D")
cnt = cnt + 1
End If
Next i
End Sub
プログラム解説
今回はデータの最終行を取得して繰り返し処理を行っています。また、転記先のシートを初期化する際、シート全体の値をクリアするにようにしています。
データの転記は、それぞれのシートを変数にして参照しています。
最終行を取得する
データを巡って値を参照する際、予めデータの行数を把握する必要があります。
以下のようなコードを使えば、ある列の最後の行を取得することが出来ます。
Activesheet.Cells(Rows.Count, 1).End(xlUp).row
取得したいワークシートオブジェクト(Activesheet)と、取得したい列(1列目)を指定します。
シート全体をクリアする
ワークシートオブジェクトの Cells にある ClearContents を使えば簡単にシート全体をクリアできます。
Activesheet.Cells.ClearContents
課題:個人用のシートを追加して転記
「中村」さんという名前のシートを作って、「中村」さんのデータ転記する。

'個人用のシートを追加して転記
Sub Macro11()
Dim ws1 As Worksheet
Set ws1 = Worksheets("Sheet1")
Dim i As Long
Dim cnt As Long
Dim lastRow As Long
'最終行を取得
lastRow = ws1.Cells(Rows.Count, 1).End(xlUp).row
Dim mName As String
mName = "中村"
'新しいデータシートを追加
'(新しいシートを追加するとそのシートがアクティブシートになる)
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.name = mName '新しくできたシートに名前を付ける
With ActiveSheet
.Range("A1") = mName
cnt = 2
For i = 2 To lastRow
If ws1.Cells(i, "A") = mName Then
.Cells(cnt, "B") = ws1.Cells(i, "B")
.Cells(cnt, "B").NumberFormatLocal = ws1.Cells(i, "B").NumberFormatLocal
.Cells(cnt, "C") = ws1.Cells(i, "C")
.Cells(cnt, "D") = ws1.Cells(i, "D")
cnt = cnt + 1
End If
Next i
End With
End Sub
プログラム解説
ここでのポイントは新しいシートを作る事です。新しいシートを作ったら、そのシートはアクティブな状態となりますので、そのままWithステートメントを使用して参照させています。
新しいデータシートを追加
新しいシートを作るだけなら、Worksheets.Add とすればOKです。ただ、これですと現在アクティブなシートの左側に作られるようです。
できれば一番左側に追加して欲しいので以下のようにオプションを付けています。
Worksheets.Add after:=Worksheets(Worksheets.Count)
after:= とすると「どのシートの後ろに配置するか」を指定できます。
「:=」という書き方はオプションの指定でVBAでは良く出てきます。
Worksheets.Count はブックの持つワークシートの数を返します。
つまり Worksheets(Worksheets.Count) とは最後のワークシートになります。
したがって、最後のワークシートの後ろに追加せよということになります。
ワークシートの名前
ActiveSheet.name = ”MySheet”
とすれば、現在アクティブなシートの名前を MySheet にすることが出来ます。
シート名を取得したい場合は、以下のようにすれば名前を取得できます。
mName = ActiveSheet.name
先程の、Worksheets.Count を使えば、全てのワークシート名を表示させることもできます。
'ワークシートの名前を全て表示
Sub printWorksheetsName()
Dim i As Long
For i = 1 To Worksheets.Count
Debug.Print Worksheets(i).name
Next i
End Sub
Debug.Print(デバッグ・プリント)
Debug.Print は、その後に続く文字列をVBEのイミディエイトウィンドウに表示させるコマンドです。テスト用に値を確認したい時に使います。
課題:個人用のシートを追加して転記(重複を回避)
前のプログラムは、2回目の実行ではシート名が重複するためエラーとなってしまいます。
そうならないようにするには、「中村」というシートがあったら削除するという方法もあります。
ここでは、既に同じシート名があった時は、シートをクリアするようにしてみましょう。
'個人用のシートを追加して転記(重複を回避)
Sub Macro11a()
Dim ws1 As Worksheet
Set ws1 = Worksheets("Sheet1")
Dim i As Long
Dim cnt As Long
Dim lastRow As Long
'最終行を取得
lastRow = ws1.Cells(Rows.Count, 1).End(xlUp).row
Dim mName As String
mName = "中村"
'全てのシートの名前を調べて既にあればシートをクリア
cnt = 0
For i = 1 To Worksheets.Count
If Worksheets(i).name = mName Then
'既にある名前のシート全体をクリアする
Worksheets(i).Cells.ClearContents
Worksheets(i).Select 'アクティブシートにする
cnt = i
Exit For
End If
Next i
If cnt = 0 Then '該当するシートが無かった場合は新たに作る
'新しいデータシートを追加
'(新しいシートを追加するとそのシートがアクティブシートになる)
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.name = mName
End If
With ActiveSheet
.Range("A1") = mName
cnt = 2
For i = 2 To lastRow
If ws1.Cells(i, "A") = mName Then
.Cells(cnt, "B") = ws1.Cells(i, "B")
.Cells(cnt, "B").NumberFormatLocal = ws1.Cells(i, "B").NumberFormatLocal
.Cells(cnt, "C") = ws1.Cells(i, "C")
.Cells(cnt, "D") = ws1.Cells(i, "D")
cnt = cnt + 1
End If
Next i
End With
End Sub
プログラム解説
これから作るワークシートと同じ名前が無いかを調べます。
For i = 1 To Worksheets.Count
としてワークシートを巡り、同じものがあれば、そのワークシートの内容をクリアして、更にSelectしてアクティブな状態にします。
また、同じワークシート名が見つかった時点でループする意味が無いので、Exit For で For文を抜けています。
If cnt = 0 Then で、同じシート名が見つかったかどうか調べています。
もし、見つかっていれば 0 以外の数字が入っているので、このIf文は実行されません。
見つからなければ、新しいシートを作って名前を付けます。
あとは、転記を行う部分なので前と同じになります。
Exit For (For文を抜ける)
Exit For は直近のFor文を抜けるコマンドになります。今回の場合は、青いアンダーライン部分から抜け出します。これ以上ループを繰返しても意味が無い時に実行します。
課題:別ブックを開いて、シートから値を取りだす
別ブックを開いて、データを取得する方法を見ていきます。
ブックを開くためには、ファイル名を含んだフルパスが必要になります。
フルパスを得るには、ファイルダイアログを開いてユーザーにファイルを選択させる方法があります。
ファイルダイアログを開いてフルパスを得る
Sub getMyFileName()
Dim vfilename As Variant
vfilename = Application.GetOpenFilename("Excelブック,*.xls?")
If vfilename = False Then
Exit Sub
End If
Debug.Print vfilename
End Sub
Application.GetOpenFilename でファイルダイアログを出してユーザーにファイルを選択してもらいます。
引数は、“Excelブック,*.xls?” と渡していますが、ダイアログを開くと以下のように、xlsという拡張子を含んだファイルが表示されるようになります。

このコマンドは、ファイルを選択して「開く」が押されると返り値には、フルパスが文字列で返ります。「キャンセル」の場合は ブール型の False が返って来るため 返り値を受け取る変数(vfilename )はバリアント型で受けています。(Variant型は、どんな型でも受け取れる変数型です。)
今回のプログラムでは、「キャンセル」が押された場合は False が来るので、これを受けたら Exit Sub で処理を終了します。False 以外であれば、vfilename にはフルパスが文字列で返ります。
Exit Sub (プロシージャを終了する)
プログラムの最中で処理を終えたい場合に、Exit Sub を使えば、そのプロシーシャを終了します。
もし、呼び出されたプロシーシャであれば呼び出し元に戻ります。
ブックを開く
ブックを開くには、Workbooks.Open( “ファイルパス” ) とします。
現在開いているブックと同じフォルダまでのパスは、ThisWorkbook.Path で取得できます。
同じフォルダ内にあるファイルであれば、以下のようにすれば開く事が出来ます。ファイル名の前に \ を付けるのを忘れないようにしましょう。
'ブックのファイル名とパスを指定して開く
Sub BookOpenTest()
Dim ws As Workbook
Set wb = Workbooks.Open(ThisWorkbook.Path & "\サンプルデータ.xlsx")
wb.Worksheets("Sheet1").Range("A1") = "sample"
wb.Close SaveChanges:=False 'ブックを保存せずに閉じる
End Sub
前のサンプルで、ファイルダイアログで得たフルパスならば、
Set wb = Workbooks.Open( vfilename )
とすればOKです。
ThisWorkbook.Path(現在ファイルと同じパス)
現在開いているブックと同じフォルダのパスを取得できます。
ファイル名部分は含まれず、最後に \ マークが無いので、付けるのを忘れないようにしましょう。
ThisWorkbook.Path & “\サンプル.xlsx“
ブックを保存せずに閉じる
プログラムでブックを開いたら、最後に閉じて終了する事が殆どです。
Set でブックを変数に入れていますので、ただ閉じるのであれば wb.Close とすれば良いのですが、この時「ファイルを保存しますか?」というメッセージが表示されます。
これをさせないために、予めブックを保存しないで閉じるようにするには、以下のようにします。
wb.Close SaveChanges:=False
オプションを True にすれば変更を保存して閉じるようになります。
別ブックを開いて、シートから値を取りだすプログラム
ファイルダイアログを開いて、開いたブックのSheet1シートのデータから「中村」さんのデータを抽出し、自身のブック(Thisworkbook) の setDataシートに転記するプログラムを示します。

'ブックを開いてデータを転記
Sub Macro12()
'ファイルダイアログを開いてファイルパスを取得
Dim vfilename As Variant
ChDir ThisWorkbook.Path '開くフォルダを指定したい時
vfilename = Application.GetOpenFilename("Excelブック,*.xls?")
If vfilename = False Then
Exit Sub
End If
'ファイルを開いて変数へ格納
Dim wb As Workbook
Set wb = Workbooks.Open(vfilename)
Dim ws1 As Worksheet
Set ws1 = wb.Worksheets("Sheet1")
Dim i As Long
Dim cnt As Long
Dim lastRow As Long
'最終行を取得
lastRow = ws1.Cells(Rows.Count, 1).End(xlUp).row
Dim mName As String
mName = "中村"
With ThisWorkbook.Worksheets("setData")
.Cells.ClearContents 'シートをクリア
.Range("A1") = mName
cnt = 2
For i = 2 To lastRow
If ws1.Cells(i, "A") = mName Then
.Cells(cnt, "B") = ws1.Cells(i, "B")
.Cells(cnt, "B").NumberFormatLocal = ws1.Cells(i, "B").NumberFormatLocal
.Cells(cnt, "C") = ws1.Cells(i, "C")
.Cells(cnt, "D") = ws1.Cells(i, "D")
cnt = cnt + 1
End If
Next i
End With
wb.Close SaveChanges:=False '開いたブックを保存せずに閉じる
End Sub
入門講座 目次
・開発環境を整える
・VBAプログラムの基礎
・VBAプログラムの基礎2
・セルの使い方
・ブックやシートの参照
・プログラムでの日付の扱い方
・プロシーシャの使い方
・「マクロの記録」を利用する
・デバッグのやり方
・やりたい事の調べ方と解決方法
・自力でプログラムを書いてみる
・別ブックのデータを集計
・別ブックのデータを集計 2
コメント