【VBA】頭文字で「あかさたな行」でレコードを検索取得する方法

エクセルVBAでツールを作るときに「レコードを頭文字で検索し取得したい！」ときがあります。

そして、「取得したレコードをフォーム上のリストボックスなどに表示したい」という人がいるかと思います。

そんなときに多くの人は「新たに専用のシートを追加して～」といった感じにするかと思います。

ですが、本記事ではＶＢＡ上で完結する方法を解説していこうと思いますので、シートをいじりたくない人はぜひ参考にしてみてください。

本記事で使うユーザーフォームとデータは下の通りです。

本記事では上のフォームの「ＯＫボタンをクリック」でマクロが呼び出されるようにしてみます。

では、さっそく解説していきます。

リストボックスに頭文字が「あ行」のレコードを表示する
【おまけ】Rangeでレコードを取得した場合のコード

リストボックスに頭文字が「あ行」のレコードを表示する

本記事では下の表を使います。

そして、今回は「上の表の氏名を使って頭文字が”あ行(あいうえお)”のレコードをフォーム上のリストボックスに表示する」という内容で書いていきます。

もちろん、頭文字が「あ行」だけではなく、「あかさたなはまやらわ」全てに使えるテクニックになっています。

そのコードになります。

Private Sub CommandButton1_Click()

    Dim ws As Worksheet
    Set ws = Sheets("Sheet1")

    ' --- 表の最終行を取得する
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    ' --- 表の最終列を取得する
    Dim lastColumn As Long
    lastColumn = ws.Cells(1, Columns.Count).End(xlToLeft).Column

    ' --- ア行のレコードを取得する
    Dim cntRow As Long
    Dim cntCloumn As Long
    Dim tmp As Long
    Dim recordData() As Variant
    ReDim recordData(lastRow, lastColumn) As Variant

    On Error Resume Next ' ア行のレコードがない場合のエラー対策
    For cntRow = 2 To lastRow
        If Application.GetPhonetic(ws.Cells(cntRow, 2).Value) Like "[ア-オ]*" Then
            For cntCloumn = 1 To lastColumn
                recordData(tmp, cntCloumn - 1) = ws.Cells(cntRow, cntCloumn)
            Next cntCloumn
            tmp = tmp + 1
        End If
    Next cntRow

    ReDim Preserve recordData(tmp - 1, lastColumn) As Variant

    ' --- ア行のレコードをリストボックスに渡す
    With Me.ListBox
        .ColumnCount = -1
        .List = recordData
    End With

End Sub

Private Sub CommandButton1_Click()

Dim ws As Worksheet

Set ws = Sheets("Sheet1")

' --- 表の最終行を取得する

Dim lastRow As Long

lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

' --- 表の最終列を取得する

Dim lastColumn As Long

lastColumn = ws.Cells(1, Columns.Count).End(xlToLeft).Column

' --- ア行のレコードを取得する

Dim cntRow As Long

Dim cntCloumn As Long

Dim tmp As Long

Dim recordData() As Variant

ReDim recordData(lastRow, lastColumn) As Variant

On Error Resume Next ' ア行のレコードがない場合のエラー対策

For cntRow = 2 To lastRow

If Application.GetPhonetic(ws.Cells(cntRow, 2).Value) Like "[ア-オ]*" Then

For cntCloumn = 1 To lastColumn

recordData(tmp, cntCloumn - 1) = ws.Cells(cntRow, cntCloumn)

Next cntCloumn

tmp = tmp + 1

End If

Next cntRow

ReDim Preserve recordData(tmp - 1, lastColumn) As Variant

' --- ア行のレコードをリストボックスに渡す

With Me.ListBox

.ColumnCount = -1

.List = recordData

End With

End Sub

簡単なコードなので、解説は省きます。

上のコードでは23行目が重要なポイントになります。

なので、23行目に関係がある下の記事も参考にしてみてください。

【VBA】Like演算子の使い方【ワイルドカードであいまい検索】

本記事では条件分岐処理などでよく使われる『Like演算子』について解説していきます。 Like演算子の使い方ここでは「Like演算子で使われるワイルドカード」と「動作確認」について解説していきます。 Like演算子で使う「ワイルドカ...

【VBA】漢字に対応した頭文字検索【GetPhoneticメソッドで読みを取得】

本記事では「漢字の読みを取得して漢字に対応した頭文字検索をする方法」について解説していきます。また、本記事のゴールは「頭文字が漢字のときに読みで識別できるようにする」になります。漢字の読みを取得して漢字に対応した頭文字検...

そして、上のコードを実行すると下のような結果が得られます。

【おまけ】Rangeでレコードを取得した場合のコード

上のほうがシンプルなので、上で紹介したコードをオススメします。

ですが、中にはRangeオブジェクトで範囲指定してレコードを取得することもあるかと思います。

そういう場合は下のコードで取得できます。

Private Sub CommandButton1_Click()

    Dim ws As Worksheet
    Set ws = Sheets("Sheet1")

    ' --- 表の最終行を取得する
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row


    ' --- 氏名の頭文字があ行のレコードの行数を取得する
    Dim cnt1 As Long
    Dim tmp As Long: tmp = 0
    Dim targetRecordRows() As Long
    ReDim targetRecordRows(lastRow) As Long '要素数は絶対に超えない数を指定する

    For cnt1 = 2 To lastRow
        If Application.GetPhonetic(ws.Cells(cnt1, 2).Value) Like "[ア-オ]*" Then
            targetRecordRows(tmp) = ws.Cells(cnt1, 2).Row
            tmp = tmp + 1
        End If
    Next

    ReDim Preserve targetRecordRows(tmp - 1) As Long


    ' --- 表の最終列を取得する
    Dim lastColumn As Long
    lastColumn = ws.Cells(1, Columns.Count).End(xlToLeft).Column


    ' --- 頭文字がア行のレコードを配列に格納する
    ' Range型→Variant型に置き換える(操作しやすさのため)
    Dim cnt2 As Long
    Dim targetRecords() As Variant
    ReDim targetRecords(tmp - 1) As Variant

    For cnt2 = LBound(targetRecordRows) To UBound(targetRecordRows)
        targetRecords(cnt2) = ws.Range("A" & targetRecordRows(cnt2) & ":" & Chr(64 + lastColumn) & targetRecordRows(cnt2))
    Next


    ' --- 上で取得したレコードデータをリストボックスに渡すデータに作り返る
    ' 「リストボックスに渡すときは２次元配列にする必要がある」ため、上のデータを作り替える
    Dim cnt3 As Long, cnt4 As Long
    Dim targetRecordsFin() As Variant
    ReDim targetRecordsFin(0 To UBound(targetRecords), 1 To lastColumn) As Variant

    For cnt3 = 0 To UBound(targetRecords)
        For cnt4 = 1 To lastColumn
            targetRecordsFin(cnt3, cnt4) = targetRecords(cnt3)(1, cnt4)
        Next
    Next


    ' --- あ行のレコード(配列)をリストボックスに渡す
    With Me.ListBox
        .ColumnWidths = "20;50;20;20;100"
        .List = targetRecordsFin
    End With

End Sub

Private Sub CommandButton1_Click()

Dim ws As Worksheet

Set ws = Sheets("Sheet1")

' --- 表の最終行を取得する

Dim lastRow As Long

lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

' --- 氏名の頭文字があ行のレコードの行数を取得する

Dim cnt1 As Long

Dim tmp As Long: tmp = 0

Dim targetRecordRows() As Long

ReDim targetRecordRows(lastRow) As Long '要素数は絶対に超えない数を指定する

For cnt1 = 2 To lastRow

If Application.GetPhonetic(ws.Cells(cnt1, 2).Value) Like "[ア-オ]*" Then

targetRecordRows(tmp) = ws.Cells(cnt1, 2).Row

tmp = tmp + 1

End If

ReDim Preserve targetRecordRows(tmp - 1) As Long

' --- 表の最終列を取得する

Dim lastColumn As Long

lastColumn = ws.Cells(1, Columns.Count).End(xlToLeft).Column

' --- 頭文字がア行のレコードを配列に格納する

' Range型→Variant型に置き換える(操作しやすさのため)

Dim cnt2 As Long

Dim targetRecords() As Variant

ReDim targetRecords(tmp - 1) As Variant

For cnt2 = LBound(targetRecordRows) To UBound(targetRecordRows)

targetRecords(cnt2) = ws.Range("A" & targetRecordRows(cnt2) & ":" & Chr(64 + lastColumn) & targetRecordRows(cnt2))

' --- 上で取得したレコードデータをリストボックスに渡すデータに作り返る

' 「リストボックスに渡すときは２次元配列にする必要がある」ため、上のデータを作り替える

Dim cnt3 As Long, cnt4 As Long

Dim targetRecordsFin() As Variant

ReDim targetRecordsFin(0 To UBound(targetRecords), 1 To lastColumn) As Variant

For cnt3 = 0 To UBound(targetRecords)

For cnt4 = 1 To lastColumn

targetRecordsFin(cnt3, cnt4) = targetRecords(cnt3)(1, cnt4)

' --- あ行のレコード(配列)をリストボックスに渡す

With Me.ListBox

.ColumnWidths = "20;50;20;20;100"

.List = targetRecordsFin

End With

End Sub

そして、上のコードを実行すると下のような結果が得られます。

ごめんなさい、上は少し面倒なコードになってしまっているかもです。

ですので、頑張って理解して改良できるところは自力でやってみてください。

では、ここでは重要なポイントだけ解説しようかと思います。

【17～22行目】”氏名”の頭文字が”ア行”のレコード行を配列に格納する

17行目から22行目では「B列の2～6行目のセルに入った氏名があ行（あいうえお）だった場合に、そのレコードの行数を配列に格納する」という処理を行っています。

その処理の条件分岐18行目では「GetPhoneticメソッドとあいまい検索を使って、漢字に対応した頭文字検索」をしています。

詳しく知りたい方は『漢字に対応した頭文字検索』を読んでみてください。

【38～40行目】Rangeで範囲指定して、レコード全体を取得する

38~40行目では”頭文字があ行のレコード(Range型)をVariant型の配列に格納する”処理を行っています。

For cnt2 = LBound(targetRecordRows) To UBound(targetRecordRows)

　　targetRecords(cnt2) = ws.Range(“A” & targetRecordRows(cnt2) & “:” & Chr(64 + lastColumn) & targetRecordRows(cnt2))

Next

Range型のままでも値を取得することはできますが、操作をしやすくするためにあえて、一般的な配列に乗せ換えています。※Range型をVariant型に代入すると、Range型のときの配列構成のまま一般の配列にすることができる。

そのレコードには複数列（５列）あるため、39行目ではRangeで範囲指定で取得するようにしています。

※今回のRange指定部分が理解できない方は『Range指定で使う列文字を列数から取得する』を読んでみてください。

【49～53行目】リストボックスが正しく認識する配列に作り替える

49~53行目では”リストボックスでレコードすべてが表示できるように二次元配列に作り替える”処理を行っています。

For cnt3 = 0 To UBound(targetRecords)

　For cnt4 = 1 To lastColumn

　　targetRecordsFin(cnt3, cnt4) = targetRecords(cnt3)(1, cnt4)

　Next

Range型は配列形式となっています。

そして、複数のセル範囲を指定した場合には、セル範囲１つに対して１つの領域に格納されることになります。※Rangeについて理解できていない方は『Range型の値を取得する』を読んでください。

下は実行時の配列の中身になります。

上の配列がRangeのセル範囲をただ入れただけの配列になります。

この配列の構成は「targetRecords(領域インデックス)(取得したレコード(２次元配列))」となっています。

つまり、この配列は”レコードデータが領域の中に入っている状態になってしまっている”ということです。

ですが、この配列をそのままリストボックスに渡しても空白が表示されるだけになってしまいます。

なので、Range特有の構成である領域を取り除いた、シンプルな二次元配列に置き換える必要があるわけです。

それが49～53行目の処理になります。

ここまでできれば、あとは59行目のようにリストボックスにレコードが入った配列を渡すことでフォーム上のリストボックスに表示されるようになります。

〇おすすめのVBA参考書ランキング！

1位	2位	3位

Excel VBA 脱初心者のための集中講座	パーフェクトExcel VBA	ExcelVBA 実戦のための技術
初心者～中級者	中級者	初心者～中級者
【初心者が手に取るべき参考書】・「書籍＋動画」で圧倒的に理解しやすい入門書になっている。・丁寧で詳しい解説でボリューム感がある。	【より深い理解をしたい方にお勧めな参考書】・テーマに対して丁寧な解説・適度な深さで解説されている。・幅広くテーマを扱っていることから、基礎知識をあらかた網羅できる。	【入門書と一緒に買うべき参考書】・１つ１つのテーマを経験豊富なエンジニア視点で解説してくれている。・実践的で効果的なコードの書き方が理解できる。
【読んでみた一言】正直、入門書はコレ一冊でいいかも。あとは中級者用の参考書に進むべし。	【読んでみた一言】深く書かれているが、少々専門的に書かれていることから、読む前に数冊の入門書を読破したほうが良い。	【読んでみた一言】基礎知識を持っている人が次のレベルに達するきっかけを与えてくれる参考書である。
￥2,794円 amazonで確認!	￥3,608円 amazonで確認!	￥2,640円 amazonで確認!