目的:在指定单元输入字幕后,自动弹出列表框提供可选择项,随着输入字母增加,自动动态刷新列表框的项。
注:列表框选择项取自另一个表的某列。
问题:有时弹出列表框,有时没有反应。
请高手帮助诊断问题所在,该如何解决?
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
Dim i As Integer
If Target.Count = 1 Then
If Target.Column = 6 And Target.Row >= 3 Then
With Me.TextBox1
.Visible = True
.Top = Target.Top
.Left = Target.Left
.Width = Target.Width
.Height = Target.Height
End With
With Me.ListBox1
.Visible = True
.Top = Target.Top + Target.Height
.Left = Target.Left + 10
.Width = Target.Width * 6
.Height = Target.Height * 8
End With
Else
Me.ListBox1.Clear
Me.TextBox1 = ""
Me.ListBox1.Visible = False
Me.TextBox1.Visible = False
End If
End If
End Sub
Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
On Error Resume Next
Dim i As Integer
Dim Language As Boolean, arr1 As Variant, arr2 As Variant, arr3 As Variant, arr4 As Variant
Dim myStr As String, str_B As String
Me.ListBox1.Clear
With Me.TextBox1
For i = 1 To Len(.Value)
If Asc(Mid$(.Value, i, 1)) > 255 Or Asc(Mid$(.Value, i, 1)) < 0 Then
Language = True
myStr = myStr & Mid$(.Value, i, 1)
Else
myStr = myStr & UCase(Mid$(.Value, i, 1))
End If
Next
End With
With Sheet2 '预设值工作表
arr1 = .Range("j2:j" & .Range("j400").End(xlUp).Row)
For i = 1 To .Range("j400").End(xlUp).Row - 1
If InStr(arr1(i, 1), myStr) Then
Me.ListBox1.AddItem arr1(i, 1)
End If
Next i
End With
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
On Error Resume Next
Dim rng As Range
Set rng = ActiveCell
Dim str As String
str = ListBox1.Value
If str <> "" And InStr(str, ";") Then
Dim arr
arr = Split(str, ";")
rng.Offset(0, -1).Value = arr(1)
rng.Value = arr(0)
Else
rng.Value = str
End If
rng.Value = Mid$(rng.Value, 1, 6)
Me.ListBox1.Clear
Me.TextBox1 = ""
Me.ListBox1.Visible = False
Me.TextBox1.Visible = False
End Sub