便利じゃなければプログラムじゃ無い!
仕事が楽になって業務効率がUPするシステムを提供!

複数のExcelブックから必要な項目をコピーして1つのシートにまとめるVBA

2017/11/10 (金) • Excel, VBANo CommentsRead More »

img_open_loop_list

今回のエントリーは複数のExcelブックから必要な項目だけコピーして一つのシートに一覧でまとめるVBAコードを紹介します。
例えば申込み用の単票Excelブックから必要な情報を拾って一覧を作成したい場合、ファイルを一つ一つ開いてコピーペーストするのは大変です。
ファイルが多いほど作業もれや見落としなど人的なミスも発生する事と思います。そんな時に便利なVBAマクロになります。

img_open_loop_list00



今回のケースはそれぞれのExcelファイルから名前・住所を取得しますが以下の様にレイアウトが異なるケースを想定したサンプルコードになります。
項目名の右隣に内容があるレイアウトであれば対応出来るものになっています。

img_open_loop_list02

サンプルプログラムは以下の通り一覧取得ボタンがあるだけのシンプルなものです。

img_open_loop_list01

上図のファイルから取得した結果は以下の通りです。

img_open_loop_list03

VBAサンプルコード

実行ボタンに割り当てるコード

'ボタンをクリックした時の処理
Public Sub sample()

Dim wFile       As String
Dim wFilePath   As String
Dim i           As Long

'Excelファイルが存在していたらファイル名を返す
wFile = Dir(ActiveWorkbook.Path & "\*.xlsx")

'先頭行を指定
i = 2

'カレントディレクトリに存在するExcelファイルを全て読み込む
Do While wFile <> ""
    
    '開くExcelファイルのフルパスを取得
    wFilePath = ActiveWorkbook.Path & "\" & wFile
    
    '名前・住所を取得し配列に格納する(区切り文字:|)
    strData = Split(File_Load(wFilePath), "|")
    
    '名前
    Cells(i, 1) = strData(0)
    
    '住所
    Cells(i, 2) = strData(1)
    
    'ファイル名
    Cells(i, 3) = wFile
    
    '次のExcelファイルを取得
    wFile = Dir()
    
    '行数をカウント
    i = i + 1

Loop

End Sub
■VBAコードの補足
  1. カレントディレクトリのExcelファイルを取得:9行目
    dir関数でファイル名をワイルドカードにしてサンプルファイルのあるディレクトリ(ActiveWorkbook.Path)に格納されているExcelファイル名を取得しています。
  2. カレントディレクトリのファイルを全て取得:15~38行目
    ファイル一覧取得については様々なサイトで説明されているのでここでは省略させていただきます。
  3. 名前・住所を取得:21行目
    Function File_Loadにファイルのフルパスを渡して名前・住所を取得します。
    取得した項目は|で区切っていますのでSplit関数で取り出して配列に格納しています。
  4. 名前・住所をセルに表示:24、27行目
    今回の様に列や行の位置が固定されない場合はCellsプロパティを使います。
    Cells(行番号,列番号)
    img_open_loop_list04

    セルに名前:strData(0)、住所:strData(1)をセットします。
    ※項目を追加した場合は配列をstrData(2)、strData(3)、strData(4)・・・のように指定して下さい。

名前・住所を取得する

※汎用性を高めるため検索項目を配列にしました。 11/13修正

'Excelファイルを開いてデータを取得
'戻り値:名前|住所 ( | で区切る)
Function File_Load(ByVal wFilePath As String) As String

Dim CurBookName As Variant
Dim ColNo       As Long
Dim RowNo       As Long
Dim strValue    As String
Dim FoundCell   As Range
Dim i           As Long


'ファイルを開く
Workbooks.Open wFilePath

'開いたExcelのファイル名を取得
CurBookName = Application.ActiveWorkbook.Name

'検索する項目を配列に格納
wItem = Array("名前", "住所")

'検索する
For i = LBound(wItem) To UBound(wItem)
    Set FoundCell = Cells.Find(What:=wItem(i))
    If FoundCell Is Nothing Then
        '検索出来なかった場合
        If i = 0 Then
            strValue = ""
        Else
            strValue = strValue & "|"
        End If
    Else
        '検索したセルに移動
        FoundCell.Select
        ColNo = ActiveCell.Column   '列番号を取得
        RowNo = ActiveCell.Row      '行番号を取得
        '住所を取得する
        If i = 0 Then
            '最初の項目
            strValue = Cells(RowNo, ColNo + 1).Value
        Else
            '2番目以降の項目は|で区切る
            strValue = strValue & "|" & Cells(RowNo, ColNo + 1).Value
        End If
    End If
Next i

'結果を返す
File_Load = strValue
    
'開いたExcelファイルを閉じる
Application.DisplayAlerts = False   '確認メッセージの非表示
Workbooks(CurBookName).Close
Application.DisplayAlerts = True    '確認メッセージの表示

End Function
■VBAコードの補足
  1. ファイルを開く:12行目
    Workbooks.OpenメソッドでExcelファイルを開きます。
  2. 検索項目を配列に格納:20行目
    Array関数で検索項目(名前・住所)を配列に格納します。
    取得する項目を増やしたい場合はカンマ(,)で区切って文字を追加して下さい。
  3. 名前を検索:23~46行目
    配列の最小インデックスをLBound関数、配列の最大インデックスをUBound関数で取得して繰り返し配列を読み込みます。(23行目)

    配列に格納した検索項目をFindメソッドで検索し列・行の位置を取得します。
    検索されたセルの一つ右のセルの値を取得します。今回の様に列や行の位置が固定されない場合はCellsプロパティを使います。(40、43行目)
    例:名前セルの右隣り → Cells(行, 列 + 1).Value

  4. ファイルを閉じる:52~54行目
    ファイルを閉じる際にメッセージが出るのを防ぐ為、ApplicationオブジェクトのDisplayAlertsプロパティで一旦非表示にします。

今回のサンプルファイルは以下のリンクからダウンロード可能です。
サンプルファイルをダウンロードする
以上、今回は複数のファイルから一覧を作成するVBAコードでした。

タグ: , , , , , , , , , ,

Comments are closed.