初心者のためのExcel エクセルマクロVBA入門-実践:印刷処理(発注書マクロ)
VLOOKUP関数をVBAで使おう
さて、いよいよ本題の発注書マクロになります。このブログほんと1個のマクロ作るのにどんだけかけてんだ?と思いますよね。しかし、「作った結果」を出すのと「作る過程」を出すのでは全然違うのですよ。。。作る過程を見せることに重点を置いているのがこのブログです。しかし、書く方は結構大変です。何度となくもう、ざっ!と書いてしまいたい。とか思うんですが、ぐっとこらえて書いています。久しぶりになるので、発注書マクロの今までの全コードを一旦載せます。
発注書ツールのシートオブジェクト内コード
Option Explicit ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' 印刷ボタン押下時のイベント ' ここに具体的な処理は書かない ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Private Sub btnPrintOrder_Click() '印刷処理を呼び出す Call mdlMain.printOutOrder End Sub ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' 会社名が選択された時に処理されるイベント ' ここに具体的な処理は書かない ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Private Sub Worksheet_Change(ByVal Target As Range) ' 変更されたのは会社名のセルなのか? If Not Application.Intersect(Target, shtOrderTool.Range("CorprateName")) Is Nothing Then ' 変更されたのが会社名だったら・・・ ' 在庫表からその会社の商品をすべて検索して ' 発注が必要な商品をリストに出力する ' ような処理をここから呼ぶ。 Call outputOrderProduct(Target.Value) ' それ以外のセルの時は何もしないよ End If End Sub
標準モジュール内のコード
Option Explicit ''''''''''''''''''''''''''''''''''''''''' ' メイン処理 ''''''''''''''''''''''''''''''''''''''''' Public outputRow As Long ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' 引数:corpName(会社名) ' 会社名に該当して、発注が必要な商品をリストアップする ' メインの処理 ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Public Sub outputOrderProduct(ByVal corpName As String) '変数の宣言 Dim rngFindResultFirst As Range ' 1回目の検索結果を保持用 Dim rngFindResult As Range ' 仕入れ先検索結果格納用 Dim retFunction As Boolean outputRow = 11 If shtOrderTool.Range("B11").Value <> "" Then ' 発注リストの出力エリアをクリアする shtOrderTool.Range(shtOrderTool.Range("B11"), shtOrderTool.Cells(Rows.Count, "E").End(xlUp)).ClearContents End If ' 最初の検索結果を取得する Set rngFindResult = shtStock.Range("F:F").Find(What:=corpName, LookAt:=xlWhole) Set rngFindResultFirst = rngFindResult ' 検索結果があればさっきの処理をする If OutputProduct(rngFindResultFirst) = False Then MsgBox "この会社の商品はありません。", vbOKOnly + vbExclamation Exit Sub End If ' 繰り返しをスタートする Do ' 在庫表シートの仕入れ先の列から会社名を検索(検索結果の次のセルから) Set rngFindResult = shtStock.Range("F:F").Find(What:=corpName, LookAt:=xlWhole, After:=rngFindResult) retFunction = OutputProduct(rngFindResult) ' 検索結果が最初のRangeオブジェクトになるまでずっと Loop Until rngFindResult.Address = rngFindResultFirst.Address ' 発注する製品がない場合にメッセージを表示する If shtOrderTool.Range("B11").Value = "" Then MsgBox "発注に必要な商品はありません", vbOKOnly End If End Sub ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' 検索結果から発注が必要な商品を出力する ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Private Function OutputProduct(ByVal rngFindRet As Range) Dim lngStock As Long ' 現在の在庫数 Dim lngNeedOrder As Long ' 必要在庫数 ' 検索結果があればさっきの処理をする If Not rngFindResultFirst Is Nothing Then ' 検索結果の行の商品在庫と必要在庫数を比較 lngStock = shtStock.Cells(rngFindRet.row, "D").Value lngNeedOrder = shtStock.Cells(rngFindRet.row, "E").Value ' 在庫 <= 必要在庫数 If lngStock <= lngNeedOrder Then ' その行で必要な情報を発注リスト表へ出力する ' No shtOrderTool.Cells(outputRow, "B").Value = shtStock.Cells(rngFindRet.row, "A").Value ' 商品名 shtOrderTool.Cells(outputRow, "C").Value = shtStock.Cells(rngFindRet.row, "B").Value ' 現在庫 shtOrderTool.Cells(outputRow, "D").Value = lngStock ' 仕入れ値=価格*0.7の切り捨て shtOrderTool.Cells(outputRow, "E").Value = Int(shtStock.Cells(rngFindRet.row, "C").Value * 0.7) outputRow = outputRow + 1 End If OutputProduct = True Exit Function Else OutputProduct = False Exit Function End If End Function ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' 検索結果から発注が必要な商品を出力する ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Public Sub printOutOrder() Dim i As Long Dim row As Long row = 15 ' 発注内容をテンプレートシートに出力する ' 11行目から商品リスト出力分まで繰り返す For i = 11 To shtOrderTool.Cells(Rows.Count, "B").End(xlUp).row ' 数量が空白または0ではないか? If shtOrderTool.Cells(i, "F").Value <> "" Or shtOrderTool.Cells(i, "F").Value <> 0 Then ' 空白または0でなければ、テンプレートに転記する shtOrderTemplate.Cells(row, "C").Value = shtOrderTool.Cells(i, "C").Value shtOrderTemplate.Cells(row, "D").Value = shtOrderTool.Cells(i, "F").Value shtOrderTemplate.Cells(row, "E").Value = shtOrderTool.Cells(i, "E").Value row = row + 1 End If Next ' 会社名を変数に格納 ' 会社情報をテンプレートに転記する ' 社名 ' 住所 ' TEL ' FAX ' 印刷する End Sub
とここまでになります。んで、次にやるのが、このコメントのところ。。。
- 会社情報をテンプレートに転記する
- 社名
- 住所
- TEL
- FAX
- 印刷する
の処理です。この1つ目の処理が前回やったVLOOKUP関数を使って実現すればいいのです。実際にコードを書くとこうなります。
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' 検索結果から発注が必要な商品を出力する ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Public Sub printOutOrder() Dim i As Long Dim row As Long Dim strCorpName As String row = 15 ' 発注内容をテンプレートシートに出力する ' 11行目から商品リスト出力分まで繰り返す For i = 11 To shtOrderTool.Cells(Rows.Count, "B").End(xlUp).row ' 数量が空白または0ではないか? If shtOrderTool.Cells(i, "F").Value <> "" Or shtOrderTool.Cells(i, "F").Value <> 0 Then ' 空白または0でなければ、テンプレートに転記する shtOrderTemplate.Cells(row, "C").Value = shtOrderTool.Cells(i, "C").Value shtOrderTemplate.Cells(row, "D").Value = shtOrderTool.Cells(i, "F").Value shtOrderTemplate.Cells(row, "E").Value = shtOrderTool.Cells(i, "E").Value row = row + 1 End If Next ' 会社情報をテンプレートに転記する ' 検索する会社名を取得する strCorpName = shtOrderTool.Range("CorprateName").Value ' 社名 shtOrderTemplate.Range("C5").Value = strCorpName ' 住所(2列目) shtOrderTemplate.Range("C6").Value = Application.WorksheetFunction.VLookup(strCorpName, shtCorprateList.Range("A1:D87"), 2, False) ' TEL(3列目) shtOrderTemplate.Range("C7").Value = Application.WorksheetFunction.VLookup(strCorpName, shtCorprateList.Range("A1:D87"), 3, False) ' FAX(4列目) shtOrderTemplate.Range("C8").Value = Application.WorksheetFunction.VLookup(strCorpName, shtCorprateList.Range("A1:D87"), 4, False) ' 印刷する End Sub
わかるでしょうか?「Application.WorksheetFunction.VLookup(strCorpName, shtCorprateList.Range("A1:D87"), 4, False)」の部分がVLOOKUP関数になります。
VBAでVLOOKUP関数を使う場合は範囲の引数はRangeオブジェクトで指定する
コードを見るとわかりますが、通常のエクセル上でVLOOKUP関数を使う場合は範囲には「"A1:D87"」のように範囲を表す文字だけで指定しましたが、VBA上ではもっと正確に指定します。つまり、「どのシートのどの範囲なのか?」ということをちゃんと指定してあげないとエクセルが( ゚д゚)?理解できないのです。したがって、
shtCorprateList.Range("A1:D87")
としています。「会社リストシートの範囲A1~D87」と翻訳できるわけですね。
印刷するPrintOutメソッド
さて、最後の印刷ですがこれはPrintOutメソッドを使うだけです。非常に簡単ですね。事前に印刷の設定を発注書テンプレートシートで行っておきさえすれば、いいわけですね。
では、やってみましょう。たった1行です。
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' 検索結果から発注が必要な商品を出力する ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Public Sub printOutOrder() Dim i As Long Dim row As Long Dim strCorpName As String row = 15 ' 発注内容をテンプレートシートに出力する ' 11行目から商品リスト出力分まで繰り返す For i = 11 To shtOrderTool.Cells(Rows.Count, "B").End(xlUp).row ' 数量が空白または0ではないか? If shtOrderTool.Cells(i, "F").Value <> "" Or shtOrderTool.Cells(i, "F").Value <> 0 Then ' 空白または0でなければ、テンプレートに転記する shtOrderTemplate.Cells(row, "C").Value = shtOrderTool.Cells(i, "C").Value shtOrderTemplate.Cells(row, "D").Value = shtOrderTool.Cells(i, "F").Value shtOrderTemplate.Cells(row, "E").Value = shtOrderTool.Cells(i, "E").Value row = row + 1 End If Next ' 会社情報をテンプレートに転記する ' 検索する会社名を取得する strCorpName = shtOrderTool.Range("CorprateName").Value ' 社名 shtOrderTemplate.Range("C5").Value = strCorpName ' 住所(2列目) shtOrderTemplate.Range("C6").Value = Application.WorksheetFunction.VLookup(strCorpName, shtCorprateList.Range("A1:D87"), 2, False) ' TEL(3列目) shtOrderTemplate.Range("C7").Value = Application.WorksheetFunction.VLookup(strCorpName, shtCorprateList.Range("A1:D87"), 3, False) ' FAX(4列目) shtOrderTemplate.Range("C8").Value = Application.WorksheetFunction.VLookup(strCorpName, shtCorprateList.Range("A1:D87"), 4, False) ' 印刷する shtOrderTemplate.PrintOut End Sub
これで終わりです。
shtOrderTemplate.PrintOut
簡単です。説明不要。あえて言うならここでもちゃんと発注書テンプレートシートにオブジェクト名をちゃんと「shtOrderTemplate」と付けていることで、どのシートを印刷しているのか?がちゃんとわかります。ちなみに印刷プレビューでいい時も同じように