下拉列表索引

Option Explicit

Private Declare Function SendMessage& Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any)
Private Const CB_SHOWDROPDOWN = &H14F
Private Const CB_SETTOPINDEX = &H15C
Private Const CB_GETDROPPEDSTATE = &H157

Private PYList() As String

'初始化
Private Sub Form_Load()
    Dim i As Integer
    
    'Combo
    With Combo1
        For i = 1 To 10
            .AddItem i
        Next
        .AddItem "北京中关村"
        .AddItem "大连联盛座"
        .AddItem "河北石家庄"
        .AddItem "河北玉晶玻璃制品有限公司"
        For i = 1 To 10
            .AddItem i + 10
        Next
    End With
   
    '拼音列表
    InitPYList Combo1
End Sub

'初始cboBox的拼音列表
Private Sub InitPYList(ByRef cboBox As ComboBox)
    Dim i As Integer
    Dim tCount As Integer
   
    tCount = cboBox.ListCount - 1
    Erase PYList
    ReDim PYList(tCount)
   
    With cboBox
        .Enabled = False
       
        For i = 0 To tCount
            PYList(i) = GetPY(.List(i))
        Next
       
        .Enabled = True
    End With
End Sub

'取字符串拼音首字
Function GetPY(ByVal x As String) As String
    Dim i As Integer
    Dim j As Integer
    Const hanzi = "啊芭擦搭蛾发噶哈击喀垃妈拿哦啪期然撒塌挖昔压匝座ABCDEFGHJKLMNOPQRSTWXYZZ"
   
    GetPY = ""
    For j = 1 To Len(x)
        For i = 1 To 24
            If Asc(Mid(x, j, 1)) >= Asc(Mid(hanzi, i, 1)) And Asc(Mid(x, j, 1)) < Asc(Mid(hanzi, i + 1, 1)) Then
                GetPY = GetPY & Mid(hanzi, 24 + i, 1)
            End If
        Next
    Next
End Function

'查找
Private Sub Combo1_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        Combo1.Text = Combo1.List(Val(Combo1.Tag))
    Else
        FindPY Combo1.Text, Combo1
    End If
End Sub

'找出拼音串tS
Private Sub FindPY(ByVal tS As String, ByRef cboBox As ComboBox)
    Dim i As Integer
    Dim tL As Integer
   
    tS = UCase(tS)
    tL = Len(tS)
   
    For i = 0 To UBound(PYList)
        If tS = Left(PYList(i), tL) Then  '找到第一个匹配的
            Me.Caption = i
           
            '下拉列表
            If Not SendMessage(cboBox.hwnd, CB_GETDROPPEDSTATE, 0, 0) Then
                SendMessage cboBox.hwnd, CB_SHOWDROPDOWN, True, 0
            End If
            '定位
            cboBox.Tag = i
            SendMessage cboBox.hwnd, CB_SETTOPINDEX, i, 0
            Exit Sub
        End If
    Next
End Sub