求助帮忙修改代码实现新需求，根据输入值模糊匹配，并把匹配项列出候选框填充的代码

Qs18

1. 
   
2. 
   
3. Private Sub ListBox1_Click()
   
4. ActiveCell.Value = ListBox1.Value
   
5. Me.TextBox1.Visible = False
   
6. Me.ListBox1.Visible = False
   
7. End Sub
   
8. 
   
9. Private Sub TextBox1_Change()
   
10. Me.ListBox1.Clear
    
11. Dim arr
    
12. arr = Sheet1.Range("d1").CurrentRegion.Value
    
13. s = TextBox1.Value
    
14. If Len(s) < 1 Then Exit Sub
    
15. s1 = Left(Trim(s), 1)
    
16. x = 0
    
17. iA = Asc(s1)
    
18. If (iA >= 65 And iA <= 90) Or (iA >= 97 And iA <= 122) Then
    
19. x = 1
    
20. Else
    
21. x = 0
    
22. End If
    
23. If x Then
    
24.     For i = 1 To UBound(arr)
    
25.         If arr(i, 2) Like "*" & s & "*" Then
    
26.         Me.ListBox1.AddItem arr(i, 1)
    
27.         End If
    
28.     Next
    
29. Else
    
30. For i = 1 To UBound(arr)
    
31.     If arr(i, 1) Like "*" & s & "*" Then
    
32.         Me.ListBox1.AddItem arr(i, 1)
    
33.    
    
34.     End If
    
35. Next
    
36. End If
    
37. 
    
38. If Len(s) >= 3 And Me.ListBox1.ListCount < 1 Then
    
39.    yy = MsgBox("您是否添加此数据", vbYesNo, "提示")
    
40.    If yy = 6 Then
    
41.         tt = VBA.Right(Trim(s), 2)
    
42.         tt = VBA.LCase(Py$(tt))
    
43.         Set rng = Me.Cells(Rows.Count, "d").End(3)
    
44.         rng.Offset(1, 0) = s: rng.Offset(1, 1) = tt
    
45.         Me.TextBox1.Visible = False
    
46.         Me.ListBox1.Visible = False
    
47.    End If
    
48.    
    
49. End If
    
50. End Sub
    
51. 
    
52. 
    
53. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
54.     If Target.Count > 1 Then
    
55.     Me.TextBox1.Visible = False
    
56.     Me.ListBox1.Visible = False
    
57.     Exit Sub
    
58. End If
    
59. With Me.TextBox1
    
60. If Target.Column = 1 Then
    
61.         .Value = ""
    
62.         .Visible = True
    
63.         .Left = Target.Left + Target.Width
    
64.         .Top = Target.Top
    
65.         .Height = Target.Height
    
66.         .Width = ListBox1.Width
    
67.         With Me.ListBox1
    
68.             .Left = Target.Left + Target.Width
    
69.             .Top = Target.Top + Target.Height
    
70.             .Visible = True
    
71.         End With
    
72.     Else
    
73.        .Visible = False
    
74.        Me.ListBox1.Visible = False
    
75.     End If
    
76.    
    
77. End With
    
78. End Sub
    
79. Function Py$(ByVal rng$)
    
80.     Dim i%, pyArr, str$, ch$
    
81.     pyArr = [{"吖","A";"八","B";"攃","C";"咑","D";"妸","E";"发","F";"旮","G";"哈","H";"丌","J";"咔","K";"垃","L";"妈","M";"乸","N";"噢","O";"帊","P";"七","Q";"冄","R";"仨","S";"他","T";"屲","W";"夕","X";"丫","Y";"帀","Z"}]
    
82.     str = Replace(Replace(rng, " ", ""), "　", "")          '去空格和Tab
    
83.     For i = 1 To Len(str)
    
84.         ch = Mid(str, i, 1)
    
85.         If ch Like "[一-龥]" Then   '如果是汉字，进行转换
    
86.             Py = Py & WorksheetFunction.Lookup(Mid(str, i, 1), pyArr)
    
87.         Else
    
88.             'Py = Py & UCase(ch)     '如果不是汉字，直接输出
    
89.         End If
    
90.     Next
    
91. End Function
    
92. 
    
93. 
    
94. 
    
95. 
    
96. 
    
97. 
    
98. 
    
99. 
    

复制代码