LoginSignup
9
3

More than 1 year has passed since last update.

概要

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

必要となるシート

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

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

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

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

②「キー(コード)」シート

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

③「抽出結果」シート

1-10-1-02.JPG

ソースコード

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

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を選択
③実行結果.JPG
「実行」ボタンをクリックすると、②で選択した行を抽出した表が③に作成され、ダイアログボックスが表示されます。
④実行結果.png

9
3
5

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
9
3