パターン別・VBA集計マクロを作ってみた。

こんにちは、Mottyです。今回はマクロについての記事となります。

##概要
ExcelVBAを用いたデータ抽出パターンについて大まかにまとめるという記事になります。いくつかのパターンに大別してまとめておくことにより、今後行う個々のタスクに対しての共通化を行うことができ、再現性の高い抽象部分が作れると思いました。

##マクロを組む際に気をつけていること

・モジュール強度が高い（扱うデータに対して固有の処理がまとまっている）
・モジュール結合度が低い（クラスやメソッドを変更しても別の部分に影響を及ぼさない）
・モジュール粒度が適切である（クラスやメソッドの責務が均等に分割されており、それぞれの機能配分も公平に配置されている）
このような部分に留意しながら記述を行なっていきます。

##マクロに要求される機能
マクロに要求される機能としてはデータを１箇所に集めてくるものが多いです。例えば各シートに散らばっているものやフォルダ内のブックに散在しているもの、Webページやテキストファイルがソースとなります。それに加えて印刷やレイアウト、テーブルの結合、メール送信などが要求される、といったイメージを持っております。

##①Each Sheets To One Sheet
各シートにデータが散在しており、それらの１つのシートへ記載するプログラムです。

![ 2020-07-19 20.00.18.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/302420/2079e660-1a43-8f8a-0ddd-ca3981ac5b18.png)
![ 2020-07-19 20.08.04.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/302420/84895600-32a1-85d6-01b7-69bacfdc43cd.png)

別シートにデータが格納されています。
![ 2020-07-19 20.00.35.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/302420/c9a609cc-270c-328a-ee94-9877afd46d67.png)

抽出ボタンを押すと、このように表示されます。
![ 2020-07-19 20.01.09.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/302420/8e897239-a3d8-65e0-0d72-b0c32a4f6d21.png)


```vb:EachSheetToOneSheet
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
各ブックにあるデータのシートへの抽出です。データリストはフォルダに入っております。
![ 2020-07-19 20.02.03.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/302420/fa8c89ca-4b13-0ff0-9a15-5db8c2bc9f89.png)


履歴書にデータが格納されています。
![ 2020-07-19 20.04.56.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/302420/6c95ae78-8d41-07c8-bbfc-45a78d868deb.png)


これらを抽出していきます。フォルダはフルパスで指定するか、ファイルダイアログ形式でユーザーに委託します。
![ 2020-07-19 20.08.04.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/302420/a897d3bb-8da9-4935-9818-eeaee16d79b8.png)

```vb:eachBookToOneSheet
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つのシートの中から条件を指定し、満たした項目だけを抜き出すものです。
![ 2020-07-19 20.09.03.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/302420/45ec8a07-2c8c-e196-24af-91ac5023b338.png)


以下では人口が１００万人以下の項目だけを抽出してきました。
![ 2020-07-19 20.09.54.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/302420/83687996-a1b6-248c-b651-c2030423d5e8.png)


```vb:Extraction
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で手軽にみられるというのも魅力的です。（要は、プログラムの結果をエクセル上で簡単に見ることができますね！）