こんにちは、Mottyです。今回はマクロについての記事となります。
概要
ExcelVBAを用いたデータ抽出パターンについて大まかにまとめるという記事になります。いくつかのパターンに大別してまとめておくことにより、今後行う個々のタスクに対しての共通化を行うことができ、再現性の高い抽象部分が作れると思いました。
マクロを組む際に気をつけていること
・モジュール強度が高い（扱うデータに対して固有の処理がまとまっている）
・モジュール結合度が低い（クラスやメソッドを変更しても別の部分に影響を及ぼさない）
・モジュール粒度が適切である（クラスやメソッドの責務が均等に分割されており、それぞれの機能配分も公平に配置されている）
このような部分に留意しながら記述を行なっていきます。
マクロに要求される機能
マクロに要求される機能としてはデータを１箇所に集めてくるものが多いです。例えば各シートに散らばっているものやフォルダ内のブックに散在しているもの、Webページやテキストファイルがソースとなります。それに加えて印刷やレイアウト、テーブルの結合、メール送信などが要求される、といったイメージを持っております。
①Each Sheets To One Sheet
各シートにデータが散在しており、それらの１つのシートへ記載するプログラムです。
別シートにデータが格納されています。
抽出ボタンを押すと、このように表示されます。
Sub EachSheetsToOneSheet()
Exportpage = 1
StartPage = 2
EndPage = ActiveWorkbook.Sheets.Count
' 抽出
For i = StartPage To EndPage
Call Extract(Sheets(Exportpage), Sheets(i))
Next
'後処理
Sheets(Exportpage).Activate
n = 3
Do While Range("A" & n) <> ""
If Not IsNumeric(Range("A" & n).Value) Then
Rows(n).Delete
End If
n = n + 1
Loop
End Sub
Function Extract(PastePage As Worksheet, CopyPage As Worksheet)
PastePage_EndRow = PastePage.Cells(Rows.Count, 2).End(xlUp).Row + 1
CopyPage.Range("A1").CurrentRegion.Copy Destination:=PastePage.Range("A" & PastePage_EndRow)
End Function
②Each Books To One Sheet
各ブックにあるデータのシートへの抽出です。データリストはフォルダに入っております。
履歴書にデータが格納されています。
これらを抽出していきます。フォルダはフルパスで指定するか、ファイルダイアログ形式でユーザーに委託します。
Type PersonalData
Name As String
Direction As String
Birthday As String
PhoneNumber As String
End Type
Sub EachBooksToOneSheet()
Rem 貼り付け先
Dim PasteWorkBook As Workbook: Set PasteWorkBook = ThisWorkbook
Dim PasteWorkSheet As Worksheet: Set PasteWorkSheet = ThisWorkbook.Sheets(1)
Dim LastRow As Long: LastRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Rem コピー元
Dim CopyWorkBook As Workbook
Dim CopyWorksheet As Worksheet
Dim CopyData As PersonalData:
Dim CopyFolderName As String
Dim CopyFileName As String
Dim folderPath As String
CopyFolderName = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
CopyFileName = Dir(CopyFolderName & "*.xls*")
Do While CopyFileName <> ""
Rem コピー元
Workbooks.Open CopyFolderName & CopyFileName
Set CopyWorkBook = ActiveWorkbook
Set CopyWorksheet = CopyWorkBook.Sheets(1)
Set CopyData = New PersonalData
CopyData.Name = CopyWorksheet.Range("C6")
CopyData.Direction = CopyWorksheet.Range("B15")
CopyData.Birthday = CopyWorksheet.Range("B9")
CopyData.PhoneNumber = CopyWorksheet.Range("H11")
Rem 貼り付け先
Dim LastRow As Long: LastRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(LastRow, 1) = CopyData.Name
Cells(LastRow, 2) = CopyData.Direction
Cells(LastRow, 3) = CopyData.Birthday
Cells(LastRow, 4) = CopyData.PhoneNumber
CopyWorkBook.Close
CopyFileName = Dir()
Loop
End Sub
③Extraction
1つのシートの中から条件を指定し、満たした項目だけを抜き出すものです。
以下では人口が１００万人以下の項目だけを抽出してきました。
Sub Extraction()
Rem コピー元
Dim CopyBook As Workbook: Set CopyBook = ThisWorkbook
Dim CopySheet As Worksheet: Set CopySheet = ThisWorkbook.Sheets(1)
Dim CopyRange As Range: Set CopyRange = CopySheet.Range("A1").CurrentRegion
Rem 貼り付け先
Dim PasteBook As Workbook: Set PasteBook = ThisWorkbook
Dim PasteSheet As Worksheet: Set PasteSheet = ThisWorkbook.Sheets(2)
Dim LastRow As Long
Dim FirstRow As Long: FirstRow = 2 'Because Header Exists
Dim Limit As Long: Limit = 1000000
Rem 抽出
CopyRange.Copy Destination:=PasteSheet.Range("A1")
PasteSheet.Activate
LastRow = PasteSheet.Cells(Rows.Count, 1).End(xlUp).Row
Stop
For CurrentRow = LastRow To FirstRow Step -1
If Range("G" & CurrentRow) >= Limit Then
Rows(CurrentRow).Delete
End If
Next
End Sub
考察
汎用的に使いまわせるプログラムを書きたく、回りくどい表現をしている部分もあるかと思います。値を二次元配列に格納してから処理を行うと速いので、このあたりも課題としていきたいです。ちなみに配列を行う場合とそうでない場合を比較すると、配列を用いた場合に実行速度が1/3になったという記事があります。他に高速化のテクニック等あれば知りたいですが・・・もしある方、コメント欄などで教えて頂きたいです。
終わりに
VBAはプログラムを始める入り口には良い教材だと思います。HTMLやCSSも立派なプログラミング言語なのですが、マークアップ言語と呼ばれる部類にカテゴライズされており、変数や配列、関数やクラスなどの概念がないため、プログラミング感覚を掴む題材としては少し物足りない感じがします。一方でいきなりC言語やJavaをやりだすと、出だしで難しい概念と対峙することになります。またセル自体が出力のインターフェースとなっており、成果物の結果をExcelで手軽にみられるというのも魅力的です。（要は、プログラムの結果をエクセル上で簡単に見ることができますね！）