请老师优化下代码，谢谢！

love_liwu

各位老师，请看： 模糊查询.zip (25.28 KB, 下载次数: 0)

2018-6-9 22:04 上传

点击文件名下载附件

，当数据较多的情况下，查询速度明显变慢、出现异常卡顿情况，请问怎么优化代码，恳请老师的指教，谢谢。
Private Sub textbox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
ListBox1.Visible = True
Static Yz As String
Dim HZSR As Boolean
a = UCase(Trim(TextBox1.Text))
b = Sheets(1).[A65536].End(xlUp).Row
'MsgBox a
If a = Yz Then Exit Sub
ListBox1.Clear
Yz = a
If LenB(StrConv(StrConv(a, vbNarrow), vbFromUnicode)) <> Len(StrConv(a, vbNarrow)) Then
HZSR = True
        Else
      HZSR = False
        End If
If HZSR Then
   'For Each aa In Sheets(1).Range("D4:D" & [A65536].End(xlUp).Row)
   'For Each aa In Sheets(1).Range("D4:D65536")
   For Each aa In Sheets(1).Range("A2:A" & b)
     If InStr(UCase(CStr(aa.Value)), a) <> 0 Then
             ListBox1.AddItem aa.Value
     End If
   Next aa
End If
If Not HZSR Then   '拼音检索，当名称多的情况下，检索速度超级慢、卡，所以取消
    For Each aa In Sheets(1).Range("A2:A" & b)
       If InStr(PINYIN(CStr(aa.Value)), a) <> 0 Then
       ListBox1.AddItem aa.Value
   End If
Next aa
End If
'MsgBox Me.ListBox1.ListCount
Application.ScreenUpdating = False
For i = 0 To Me.ListBox1.ListCount - 1
    'aa = Len(Me.ListBox1.List(i))
    'MsgBox aa
   If Len(Me.ListBox1.List(i)) > aa Then
    aa = Len(Me.ListBox1.List(i))
   End If
Next
'Sheet12.Cells(15, "P") = aa
'Sheet12.Cells(16, "P") = Me.ListBox1.Font.Size
'MsgBox "the max:" & i
   With Me.ListBox1
     If aa > 0 And aa < 15 Then
     .Width = .Font.Size * 15 + 10
     End If
      If aa >= 15 And aa < 20 Then
     .Width = .Font.Size * aa - 30
     End If
     If aa >= 20 And aa < 30 Then
     .Width = .Font.Size * aa + 30
     End If
        '.Height = .ListCount * .Font.Size + 4
        '.Width = aa + 2
        'Me.Height = .Top + .Height + 30
   End With
Application.ScreenUpdating = True
End Sub
Private Sub ListBox1_Click()
Sheet1.[B2] = ListBox1.Value
ListBox1.Visible = False
End Sub

模块一代码：
Public Function PINYIN(AAAA As String) As String  '拼音检索，当名称多的情况下，检索速度超级慢、卡，所以取消
On Error Resume Next
PINYIN = ""
For a = 1 To Len(Trim(AAAA))
PINYIN = PINYIN + Application.WorksheetFunction.VLookup(Mid(Trim(AAAA), a, 1), [{"吖","A";"八","B";"嚓","C";"咑","D";"鵽","E";"发","F";"猤","G";"铪","H";"夻","J";"咔","K";"垃","L";"嘸","M";"旀","N";"噢","O";"妑","P";"七","Q";"囕","R";"仨","S";"他","T";"屲","W";"夕","X";"丫","Y";"帀","Z"}], 2)
Next a
End Function

love_liwu

请老师帮忙看看，谢谢！