Excel首字拼音模糊搜索及快捷录入

作者：江苏大侠

'工作表打开事件里先把清单加载到arr数组，同时提取每个商品的拼音首字母保存到brr数组。

Private Sub Workbook_Open()

    Dim br

    arr = Sheet2.UsedRange

    ReDim br(1 To UBound(arr))

    For i = 1 To UBound(arr)

        br(i) = pinyin(arr(i, 1))

    Next

    brr = br

End Sub

'ASC码在-20319~-10247之间的为汉字，通过比较汉字在字符串中顺序获得首字母。

Public Function pinyin(ByVal r As String)

    hz = "啊芭擦搭蛾发噶哈击喀垃妈拿哦啪期然撒塌挖昔压匝ABCDEFGHJKLMNOPQRSTWXYZZ"

    For i = 1 To Len(r)

        If Asc(Mid(r, i, 1)) > -10247 Or Asc(Mid(r, i, 1)) < -20319 Then

            temp = Mid(r, i, 1)

        Else

            For j = 1 To 24

                If Asc(Mid(r, i, 1)) >= Asc(Mid(hz, j, 1)) Then temp = Mid(hz, 23 + j, 1)

            Next

        End If

        pinyin = pinyin & temp

    Next

End Function

'工作表选择事件中，如果单元格在第一列则显示组合框，并设置组合框与单元格完全匹配。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    On Error Resume Next

    With ComboBox1

        .Visible = False

        If ActiveCell.Column = 1 Then

            .Top = Target.Top:  .Height = Target.Height: .Width = Target.Width: .ListWidth = 230

            .Visible = True: .Activate: .Text = ActiveCell.Text

        End If

    End With

End Sub

'当组合框获得焦点时将arr数组加载到组合框列表中。

Private Sub ComboBox1_GotFocus()

    ComboBox1.List = WorksheetFunction.Transpose(arr)

    ComboBox1.DropDown

End Sub

'在组合框里输入内容（方向键和回车键忽略）进行模糊搜索，可以直接输入中文也可以输入汉字首字母查找，加空格可以多条件，如要找330ml的可乐，可以输入"kl 330"或者"330 kl"查找

Private Sub ComboBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

    If KeyCode <> 37 And KeyCode <> 38 And KeyCode <> 39 And KeyCode <> 40 And KeyCode <> 13 Then

        ActiveCell.Value = ComboBox1.Text

        Set d = CreateObject("Scripting.Dictionary")

        For i = 1 To UBound(arr)

            If InStr(1, arr(i, 1), ComboBox1.Value) > 0 Then d(arr(i, 1)) = ""

            If InStr(1, brr(i), Split(ComboBox1.Value & " ", " ")(0), 1) > 0 And InStr(1, brr(i), Split(ComboBox1.Value & " ", " ")(1), 1) > 0 Then d(arr(i, 1)) = ""

        Next

        ComboBox1.List = d.keys

    End If

End Sub

'当在组合框里选择或者回车时，将组合框的内容赋值到单元格。

Private Sub ComboBox1_Click()

    ActiveCell = ComboBox1.Value

End Sub

Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

    If KeyCode = 13 Then

        If ComboBox1.ListCount = 1 Then ComboBox1.ListIndex = 0

        If ComboBox1.ListIndex > -1 Then ActiveCell = ComboBox1.Value

        ActiveCell.Select

    End If

End Sub

这个功能在企业和工厂的实际办公场景有很多用途，值得学习和借鉴。