Excel首字拚音模糊搜索及快捷録入

2017-07-11 17:54:00
zstmtony
原創
1541

Excel穫取中文的拚音碼或拚音首字,相信大傢都有見識過,在網上也可以搜索到很多相關的函數或VBA代碼,但根據首字拚音來進行模糊搜索,併自動匹配及縮小選擇範圍,併迴車自動録入,估計很多網友沒有見過或嚐試過

今天Office中國就在Excel培訓部落給大傢帶來這篇教程。


一、實現效果

作者:江蘇大俠

Excel技巧



Excel技巧



Excel技巧

二、動畵顯示

Excel技巧


三、VBA代碼

'工作錶打開事件裡先把清單加載到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

這箇功能在企業和工廠的實際辦公場景有很多用途,值得學習和借鑒。
分享