Excel VBA 単票(別個のブック)からデータを抽出して一覧にまとめる


いろんな人から受け取った請求書や注文書などの単票を一覧にまとめる作業を合理化します。基幹システムなどがなく、各人が手書き代わりにExcelを使って帳票を作り、誰かがそれを別の表にまとめるという仕事がまだまだあると思います。そういう仕事はできるだけマクロにやってもらいたいですね。

(サンプルはこちらからダウンロード)

使い方

1. 転記ボタンを押す

2. 追加する単票(Excelブック)を選択する

3. 抽出されたデータが一覧に転記される

準備

1. 単票を作り、抽出したいデータが入っているセルに名前を付けます(下図を参照)

2, 別のブックに下図のような一覧を作ります。もちろん、ヘッダーは単票の項目名と合わせておいた方がいいです。マクロ実行ボタン(転記ボタン)を配置します。

処理の流れ

1. 転記ボタンを押した時にsampleプロシージャーが実行される。

2. [sample] ファイル選択ダイアログで選択された注文書(Excelブック)のパスを配列に入れる。

3. [sample] 注文一覧の次に追加する行番号とブックのパスをsetOrderArrayToWSに渡す(注文書の数だけループする)

4. [setOrderArrayToWS] getOrderArrayで注文書のデータを抽出し、配列に入れてsetOrderArrayToWSに返す。

5. [setOrderArrayToWS] 3で取得した配列を注文一覧に貼り付ける。

ソースコード

'メイン Sub sample() Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("注文一覧") '注文単票を選択させてパスを配列に入れる Dim fileArray As Variant fileArray = Application.GetOpenFilename(FileFilter:="Microsoft Excelブック,*.xls?", _ MultiSelect:=True) If IsArray(fileArray) = False Then Exit Sub Dim wbPath As Variant For Each wbPath In fileArray Dim startRow As Long '注文一覧の最終行を取得して次の貼り付け位置を決める startRow = ws.Range("A" & Rows.Count).End(xlUp).Row + 1 Call setOrderArrayToWS(wbPath, ws, startRow) Next End Sub '注文データの配列を注文一覧に貼り付ける Sub setOrderArrayToWS(wbPath As Variant, targetSheet As Worksheet, startRow As Long) Dim orderArray As Variant orderArray = getOrderArray(wbPath)

With targetSheet Dim rw As Long, cl As Long For rw = 0 To UBound(orderArray, 1) For cl = 0 To UBound(orderArray, 2) .Cells(rw + startRow, cl + 1).Value = orderArray(rw, cl) Next Next End With End Sub '注文単票から注文データの抽出して配列に入れる Function getOrderArray(wbPath As Variant)

 '別のApplicationを作って不可視状態で実行します。 Dim xlApp As Excel.Application Dim wb As Workbook Set xlApp = New Application xlApp.Visible = False Set wb = xlApp.Workbooks.Open(wbPath) With wb.Sheets("注文書")

'注文書の上半分のデータを取得

Dim customer As String: customer = .Range("発注元")

Dim orderDate As String: orderDate = .Range("注文日")

Dim person As String: person = .Range("担当者")

'注文書の詳細リスト部分

Dim bdRange As Range: Set bdRange = .Range("注文詳細")

End With

'注文書の詳細リスト部分からデータを取得して配列に入れる

Dim rowUbound As Long: rowUbound = bdRange.Rows.Count - 1

Dim orderArray() As Variant

ReDim orderArray(rowUbound, 6)

For counter = 0 To rowUbound If bdRange(counter + 1, 1).Value = "" Then Exit For Dim itemCode As String: itemCode = bdRange(counter + 1, 1).Value Dim itemName As String: itemName = bdRange(counter + 1, 2).Value Dim qty As String: qty = bdRange(counter + 1, 3).Value Dim price As String: price = bdRange(counter + 1, 4).Value orderArray(counter, 0) = orderDate orderArray(counter, 1) = customer orderArray(counter, 2) = person orderArray(counter, 3) = itemCode orderArray(counter, 4) = itemName orderArray(counter, 5) = qty orderArray(counter, 6) = price Next getOrderArray = orderArray

wb.Close Set wb = Nothing Set xlApp = Nothing End Function

#ExcelVBA #帳票