＜Excel VBA＞表からデータを抽出して別シートに表作成

8310 ワード
新人プログラマ応援 VBA マクロ 初心者 Excel Excel テキストリンク

概要

この記事では、Excelの表から指定したキーの行を抽出し、別シートに表を作成するというマクロ処理のVBAソースコードを公開します。

必要となるシート

ここでは、ソースコードの前に、マクロを実行する上で必要となるExcelシートを簡単に説明します。

まず、抽出元となる表です。
画像では下が切れていますが、47都道府県の都道府県庁所在地、市・町・村それぞれの数を表にしています。

①「都道府県一覧」シート


続いて、キーとなる「コード」だけを記載したシートです。
特定の行だけを抽出できるよう、フィルター機能を使っています。

②「キー（コード）」シート


抽出した行から表を作成するシートです。
「実行」ボタンをクリックすることで、マクロを実行し、表を作成します。

③「抽出結果」シート

ソースコード

①の表から②で指定した行のみを抽出し、③に表を作成するという処理内容です（シートを番号で表記）。

Sub Prefectures()

Dim ws_pref As Worksheet: Set ws_pref = Worksheets("都道府県一覧")
Dim ws_key As Worksheet: Set ws_key = Worksheets("キー（コード）")
Dim ws_result As Worksheet: Set ws_result = Worksheets("抽出結果")

With ws_key
    .Range("a1").CurrentRegion.SpecialCells(xlVisible).Copy ws_result.Range("a1")
    If .FilterMode = True Then
        .ShowAllData
    End If
End With

Dim arr As Variant
With ws_result
    arr = .Range(.Range("a2"), .Cells(Rows.Count, 1).End(xlUp))
End With

Dim brr As Variant
brr = WorksheetFunction.Transpose(arr)
Dim strArray() As Variant
Dim i As Integer

For i = 1 To UBound(brr)
ReDim Preserve strArray(i - 1)
strArray(i - 1) = str(brr(i))
Next

With ws_pref
    .Range("a1").AutoFilter field:=1, Criteria1:=strArray, Operator:=xlFilterValues
    .Range("a1").CurrentRegion.SpecialCells(xlVisible).Copy ws_result.Range("a1")
    .AutoFilterMode = False
End With


MsgBox "処理が完了しました"

End Sub

詳しい説明は、以下、ご参照ください。

参考

・WorksheetFunctionについて
・WorksheetFunction（ワークシート関数の使い方）
・AutoFilter

マクロVBAの準備や実行方法などの使い方は、以下のサイトで確認できます。
・Excelマクロの使い方入門（初心者向け）！作成〜保存方法まで
・エクセルの神髄 ExcelマクロVBA入門編
因みに、私は「エクセルの神髄」で勉強しました。実際に手を動かしてみるのが1番だと思います。
マクロVBAにかかわらず、ショートカットキーを覚えると便利ですよ！

実行結果

②でキーとなる「コード」を選択（フィルタリング）します。
※図では、2、13、18、21、26を選択

「実行」ボタンをクリックすると、②で選択した行を抽出した表が③に作成され、ダイアログボックスが表示されます。