初心者のためのExcelマクロ超入門(絶対できるVBA開発)

マクロがまったくわからない人のためにエクセルマクロやVBAについてできるだけわかりやすく書いています。Twitter:@shuhhohhey

初心者のための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関数になります。

Application.WorksheetFunction.関数名

VBAでワークシート関数を利用する時にはこのような書き方になります。VBA上ではどういう言い方をしているか?というと、直訳で、「エクセルアプリケーションのワークシート関数オブジェクトの○○関数」という言い方です。VLookup以外でもSumやCountIfなどワークシート関数ならすべてこれで利用できます。

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」と付けていることで、どのシートを印刷しているのか?がちゃんとわかります。ちなみに印刷プレビューでいい時も同じように

shtOrderTemplate.PrintPreview

とすればいいだけです。


これでプロトタイプの完成です。さしあたって、発注担当者はこのマクロ使って発注を簡単に行うことができそうです。各シートにCSVダウンロードした在庫表と会社リストを張り付けてさえしまえば、後は簡単に発注書が印刷できます。

後は、CSVで在庫表を読み込む機能を付けたり。他にも便利な機能を付けてあげれば良いのです。


発注書マクロはこのプロトタイプで一応おしまいです。疲れた・・・orz。これで、マクロでのツール作成のなんたるか?みたいなものをちょっとでも感じてくれたら幸いです。


以上です!


今日はここまで!


かしこ