Excelの苦しい業務もVBAで気を紛らわす

VBAを利用して、csvのある列から抽出したデータを一つのファイルに並べていく方法です。

現場にて、必ず発生するExcel作業。
その中で今回は、某資産管理ツールから数百台の端末それぞれに入っている全アプリケーション情報をエクスポートし、各部門ごとの標準アプリケーションを決める仕事を任された。

まず辛かったのはエクスポート作業。
イケてない管理方法とツールのお陰様で１台１台エクスポートをぽちぽち押して、Excelファイルにしていく。。。

これだけで苦痛だが、さらに台数分ある、アプリケーション情報をまとめて全台数中どのくらいの割合で各アプリケーションが入っているのか見ていくのだ。

これには心が折れそうになった。
数百あるExcelファイルで各ファイル中必要な情報は１行だけ。
それらを抽出し、一つのファイルにまとめる作業から入らなければならない。

せっかく最近プログラミングというものを覚えてきたので、それに近しいVBAを利用してこの作業を自動化することで行き場のない思いを晴らすことにした。

やりだすとそこそこ楽しかったので備忘録的に残しておく。

以下、VBA Scrypt(と簡単な説明)

■環境
OS : Windows10
Tool : Microsoft Office Excel 2013

■説明
複数のエクセルシートから同じ列の値を横に並べていく
ファイル名1.xlsx~n.xlsxでC:\sample配下にあるとする。 (nは実際の数字を入れること)
抽出したい列はB、で順に並べていく

基本的には

　対象ファイルを開く
→ B列を抽出する
→ まとめファイルに貼り付け
→ ファイルを閉じる
→ ファイル数分繰り返し

■手順
macro.xlsx(←名前はなんでも可)を同フォルダに置き開く
⇒ Alt + F11
⇒ 挿入　
⇒ 標準モジュール　
⇒ 下記のスクリプトを貼り付け実行

VBA

//関数の名前
Sub MacroChallenge()

//myPathを定義
  Const myPath As String = "C:\sample\"

//wbを定義
  Dim wb As Workbook
  Set wb = Workbooks("macro.xlsx")

//rIdxに数字`1`を代入
  Dim rIdx As Long
  rIdx = 1

//fNameを定義
  Dim fName As String

//"n.xlsx"という名前のファイルまで来たら抽出して貼り付けていく作業を辞める。
  Do Until rIdx = n + 1 (→`n + 1`には実際の数字を入れる)

//fNameに"n.xlsx"を代入
    fName = Dir(myPath & rIdx & ".xlsx")

//"n.xlsx"を開く
    Workbooks.Open Filename:=myPath & fName

//"n.xlsx"の１枚目のシートから"B"列を抽出して"macro.xlsx"の"macro"シートのA列から1列ずつ貼り付けていく
    wb.Worksheets("macro").Columns(rIdx).Value =　Workbooks(fName).Worksheets(1).Columns(2).Value

//"n.xlsx"を閉じる
    Workbooks(fName).Close SaveChanges:=False

//rIdxに１を加えてrIdxに代入
    rIdx = rIdx + 1

//  "Do Until rIdx = n + 1"に戻る
  Loop
End Sub

上記のものでも200ファイルで5分ほどかかったので、もっといい方法があれば随時更新（きっと）。
遊び感覚でできて良い。