'読み仮名のリストボックスで指定文字へジャンプするサンプルマクロ

'MakeSampleSheetマクロを実行後、Testマクロを実行してください。

Option Explicit

Const DialogSheetName As String = "顧客選択"
Const ListSheetName As String = "顧客リスト"
Const ListRangeName As String = "顧客リスト!A:B"
Const ListDisplayColumn As Integer = 2

Dim flagFirst As Integer
Dim flagOption As Integer

'テストマクロ
Sub Test()
    With ThisWorkbook.DialogSheets(DialogSheetName)
        If .Show Then
            With .ListBoxes(1)
                If .ListIndex > 0 Then
                    MsgBox .List(.ListIndex) & " (" & .ListIndex & ")"
                End If
            End With
        End If
    End With
End Sub

'フォーム表示時マクロ
Sub Form1_Show()
    If flagFirst = 0 Then
        InitListBox
        flagFirst = 1
    End If
End Sub

'オプションボタンクリック時マクロ
Sub OptionButtons_Click()
    Dim s As String
    Dim r As Range
    Dim n As Integer
    Dim v As Variant

    '一度リストボックスにENDキーを送る
    If flagOption = 0 Then
        SendKeys "{TAB}{END}+{TAB} "
        flagOption = 1
        Exit Sub
    Else
        flagOption = 0
    End If

    'オプションボタンのテキストの取得
    s = ActiveDialog.DrawingObjects(Application.Caller).Text
    If s = "英数" Then s = "0"

    With ActiveDialog.ListBoxes(1)
        n = .ListCount
        If n = 0 Then Exit Sub

        '入力範囲の取得
        Set r = Application.Evaluate(.ListFillRange)

        '一致またはより小さい最大値を取得
        v = Application.Match(s, r, 1)
        If IsError(v) Then
            .ListIndex = 1
        ElseIf v = n Then
            .ListIndex = v
        ElseIf s = Left$(.List(v), 1) Then
            .ListIndex = v
        Else
            .ListIndex = v + 1
        End If
    End With
End Sub

'リストボックスを初期化するマクロ
Sub InitListBox()
    Dim r As Range
    Dim s As String

    'リスト範囲の取得
    Set r = Application.Evaluate(ListRangeName)

    'リスト範囲を並び替える
    r.SortSpecial SortMethod:=xlSyllabary, _
        Key1:=r.Range("B2"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

    'リストボックス表示用範囲のアドレスを取得
    With r.Cells(1, 1).CurrentRegion.Columns(ListDisplayColumn)
        If .Rows.Count = 1 Then
            s = ""
        Else
            s = .Resize(.Rows.Count - 1).Offset(1).Address(external:=True)
        End If
    End With

    '入力範囲の設定
    With ThisWorkbook.DialogSheets(DialogSheetName)
        With .ListBoxes(1)
            .ListFillRange = s
            If .ListCount > 0 Then .ListIndex = 1
        End With
        .OptionButtons(1).Value = xlOn
    End With

End Sub


'サンプルシートを作成するマクロ
Sub MakeSampleSheet()
    Dim dlg As DialogSheet
    Dim gw As Double
    Dim i As Integer
    Dim s As String

    'ワークシートの作成
    With Worksheets.Add
        .Name = ListSheetName
        .Range("A1:B1").Value = Array("名前", "よみ")
        .Range("A2:B2").Value = Array("Name1", "123A")
        .Range("A3:B3").Value = Array("NameA", "ABC")
        For i = 177 To 220
            s = StrConv(Chr$(i), vbWide Or vbHiragana)
            .Cells((i - 177) * 10 + 4, 1).Resize(10, 2).Value _
                = Array("Name" & s, s & "あいう")
        Next
    End With

    'ダイアログシートの作成
    s = "あかさたなはまやらわ"
    Set dlg = DialogSheets.Add
    dlg.Name = DialogSheetName
    gw = dlg.Buttons(1).Height / 3
    With dlg.DialogFrame
        .Left = gw * 13: .Top = gw * 4
        .Width = gw * 66: .Height = gw * 28
        .Caption = DialogSheetName
        .OnAction = "Form1_Show"
    End With
    dlg.DrawingObjects.Delete
    For i = 1 To 10
        With dlg.OptionButtons.Add( _
                Left:=gw * (15 + ((i - 1) \ 5) * 8), _
                Top:=gw * (10 + ((i + 4) Mod 5) * 3), _
                Width:=gw * 8, Height:=gw * 3)
            .Caption = Mid$(s, i, 1)
        End With
    Next
    With dlg.OptionButtons.Add(Left:=gw * 23, _
            Top:=gw * 25, Width:=gw * 8, Height:=gw * 3)
        .Caption = "英数"
    End With
    dlg.GroupBoxes.Add(Left:=gw * 14, Top:=gw * 8, _
        Width:=gw * 20, Height:=gw * 22).Caption = ""
    dlg.OptionButtons.OnAction = "OptionButtons_Click"
    With dlg.ListBoxes.Add(Left:=gw * 35, Top:=gw * 8, _
            Width:=gw * 32, Height:=gw * 23)
    End With
    With dlg.Buttons.Add(Left:=gw * 68, Top:=gw * 8, _
        Width:=gw * 10, Height:=gw * 3)
        .Caption = "OK"
        .DismissButton = True
        .DefaultButton = True
    End With
    With dlg.Buttons.Add(Left:=gw * 68, Top:=gw * 12, _
        Width:=gw * 10, Height:=gw * 3)
        .Caption = StrConv("キャンセル", vbNarrow)
        .CancelButton = True
    End With

    'リストボックスの初期化
    InitListBox
End Sub