代码偶尔报错求高手指点

zaopzt

1. Private Sub TextBox1_Change()
   
2. If x = 1 Then  '
   
3. ActiveCell = TextBox1.Value
   
4. Me.ListBox1.Clear
   
5. On Error Resume Next
   
6. <font color="#ff0000">    For i = LBound(frr) To UBound(frr)</font> '<font color="#ff0000">会出现错误这段会偶尔报错下标越界</font>
   
7.         If InStr(frr(i), Me.TextBox1.Value) > 0 Then
   
8.          Me.ListBox1.AddItem frr(i)
   
9.     End If
   
10.     Next
    
11.     If TextBox1 <> "" And ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
    
12. End If
    
13. '---------------------------------------------------------------------------
    
14. If x = 2 Then '工程名称
    
15. ActiveCell = TextBox1.Value
    
16. Me.ListBox1.Clear
    
17.     For i = LBound(frr) To UBound(frr)
    
18.         If InStr(frr(i), Me.TextBox1.Value) > 0 Then
    
19.          Me.ListBox1.AddItem frr(i)
    
20.     End If
    
21.     Next
    
22.     If TextBox1 <> "" And ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
    
23.       
    
24. End If
    
25. 
    
26. End Sub
    
27. 
    
28. Private Sub TextBox1_GotFocus()
    
29. Me.ListBox1.Clear
    
30. If x = 1 Then '公司名称
    
31.   If IsEmpty(drr) Then
    
32.         With Worksheets("基础信息表")
    
33.             drr = .Range("a2:h" & .Range("A65536").End(xlUp).Row)
    
34.         End With
    
35.     End If
    
36.     Dim dic
    
37.     Set dic = CreateObject("scripting.dictionary")  '建立字典
    
38.     For i = LBound(drr) To UBound(drr)
    
39.             dic(drr(i, 2)) = 1
    
40.     Next
    
41.         Me.ListBox1.List = dic.keys  '获得对应规格型号
    
42.         frr = dic.keys
    
43. End If
    
44.   If x = 2 Then '工程名称
    
45.     Me.ListBox1.Clear
    
46.         If IsEmpty(drr) Then
    
47.             With Worksheets("基础信息表")
    
48.                 drr = .Range("a2:h" & .Range("A65536").End(xlUp).Row)
    
49.             End With
    
50.         End If
    
51.         Dim gd As String
    
52.         gd = ActiveCell.Offset(-1, 0).Value
    
53.         If gd = "" Then Exit Sub
    
54. 
    
55.         Dim dic2
    
56.         Set dic2 = CreateObject("scripting.dictionary")  '建立字典
    
57.         For i = LBound(drr) To UBound(drr)
    
58.             If drr(i, 2) = gd Then
    
59.                 dic2(drr(i, 3)) = 1
    
60.             End If
    
61.         Next i
    
62.         grr = dic2.keys  '
    
63.         Me.ListBox1.List = dic2.keys
    
64.         frr = dic2.keys
    
65.         Dim dic1
    
66.         Set dic1 = CreateObject("scripting.dictionary")  '建立字典
    
67.         For i = LBound(grr) To UBound(grr)
    
68.             If InStr(grr(i), Me.TextBox1.Value) > 0 Then
    
69.                 dic1(grr(i)) = 1
    
70.             End If
    
71.         Next i
    
72.         Me.ListBox1.List = dic1.keys  '获得对应规格型号
    
73. End If
    
74. End Sub
    
75. 
    
76. Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    
77. Dim i As Integer
    
78. Select Case KeyCode
    
79.     Case vbKeyDown
    
80.         i = ListBox1.ListIndex + 1
    
81.         If i < ListBox1.ListCount Then ListBox1.ListIndex = i Else ListBox1.ListIndex = 0
    
82.     Case vbKeyUp
    
83.         i = ListBox1.ListIndex - 1
    
84.         If i > -1 Then ListBox1.ListIndex = i Else ListBox1.ListIndex = ListBox1.ListCount - 1
    
85.     Case vbKeyReturn
    
86.         If ListBox1.ListIndex = -1 Then
    
87.             ActiveCell.Offset(1, 0).Activate
    
88.         Else
    
89.             ActiveCell = ListBox1.List(ListBox1.ListIndex)
    
90.             ActiveCell.Offset(0, 1).Activate
    
91.         End If
    
92. End Select
    
93. End Sub
    
94. Private Sub Worksheet_SelectionChange(ByVal Target As Range)  '鼠标选定触发
    
95. drr = Sheet1.Range("a2:h" & Sheet1.Range("A65536").End(xlUp).Row)
    
96. If Target.Count > 1 Then Exit Sub
    
97. With TextBox1
    
98. If (Target.Column = 2 And Target.Row = 1) Or (Target.Column = 2 And Target.Row = 2) Then   '第 列第 行
    
99. x = Target.Row
    
100. .Top = Target.Top
     
101. .Width = Target.Width
     
102. .Left = Target.Left
     
103. .Height = Target.Height
     
104. .Value = Target.Value
     
105. .Visible = True
     
106. .Activate
     
107. With ListBox1
     
108. .Top = TextBox1.Top + TextBox1.Height
     
109. .Left = TextBox1.Left
     
110. .Width = TextBox1.Width
     
111. .Visible = True
     
112. .ListIndex = -1
     
113. End With
     
114. Else
     
115. .Visible = False
     
116. ListBox1.Visible = False
     
117. End If
     
118. End With
     
119. End Sub
     

复制代码

此段代码为了实现二级模糊匹配输入公司名称和对应的工程名称，红色部分偶尔会出现下标越界的错误提示，猜测是因为frr没有取到值，尝试使用 IsEmpty(frr）判断为空从新获取数据，发现frr为空时也不认定为空，求高手解惑，谢谢！

taller