Arrays VBA使用Like运算符在数组中查找字符串无效
我有一个Excel文件,其中包含表名及其对应的列,如下所示: 我编写了一个子过程,返回表名的所有对应列 我的当前代码执行以下操作:Arrays VBA使用Like运算符在数组中查找字符串无效,arrays,excel,vba,pattern-matching,Arrays,Excel,Vba,Pattern Matching,我有一个Excel文件,其中包含表名及其对应的列,如下所示: 我编写了一个子过程,返回表名的所有对应列 我的当前代码执行以下操作: 将列A(表名)和列B(列名)保存到二维数组 查看数组以查找表的名称是否存在于中 数组的第一列 如果表名存在,则计数器 每次值增加时,都会重新标注另一个数组的尺寸 在数组中发生 然后我将该数组设置为原始数组 数组并将该列名数组返回到工作表 我有一个错误处理程序,其中说如果表名不是表的全名(即用户是短字符,或输入了数组中不存在的表名),则显示以下消息: “您必须输入表
“您必须输入表格的全名。”
我的问题是,无论是否输入了正确的表名,上面的错误处理程序都会显示错误,我不知道原因。如果我删除错误处理程序,代码会运行得很好…直到有人输入了数组中不存在的表名,这就是令人费解的错误处理程序应该解决的问题,除非它不能正常工作,哈哈
有人知道什么地方出了问题以及如何解决吗??它必须能够以非常快的速度处理具有大量数据的相当大的阵列
感谢您提前提供任何想法、建议或答案
注意:我有超过100000行,因此application.Match、Index或组合将不起作用。
以下是完整的代码:
Option Compare Text
Option Explicit
Sub Testingggg()
Dim Big_Array(), small_array() As Variant
Dim i, j, LookUpValue_Counter As Long
Dim LookUpValue As String
Application.ScreenUpdating = False
'Clear previously returned data
Worksheets("New TRAX").Range("C2:D300").ClearContents
If UserForm2.txttablecols.Value <> "" Then
LookUpValue = UserForm2.txttablecols.Value
Else
MsgBox "You must enter a the name of the table.", vbExclamation, "Error Encountered"
Exit Sub
End If
'Store cols A and B in the Big_Array
Big_Array = Range("A2").CurrentRegion
'Starting in the second row of the Big_Array loop through _
each element of the Big_Array
For i = LBound(Big_Array, 1) To UBound(Big_Array, 1)
'Note: I used Option Compare Text at the _
beginning of the module to make the text _
comparisons case insensitive
'This searches the second Col (i.e. Column Names) only
If Big_Array(i, 2) Like LookUpValue Then
MsgBox "You must enter the name of the Table, NOT the Column", vbExclamation, "Error Encountered"
Exit Sub
'*******************************************************
'This ElseIf is what gives me problems. Like I said _
before, if I remove this, the other code and error _
handlers work perfectly. However if the the user _
enters a table name that doesn't exist, then the code _
won't run, but that makes sense, b/c that's what error _
handler is for...except it doesn't work, lol.
'*******************************************************
This searches the first Col (i.e. Table Names) only
ElseIf Not (Big_Array(i, 1) Like LookUpValue) Then
MsgBox "You must enter the the full name of the Table.", vbExclamation, "Error Encountered"
Exit Sub
'If the table name exists and is in the correct _
format, then execute the following
ElseIf Big_Array(i, 1) Like LookUpValue Then
'increase the LookUpValue_Counter by 1 each _
time the LookUpValue matches a value in col A
LookUpValue_Counter = LookUpValue_Counter + 1
'Redimension the small_array array with each instance _
of a the LookUpValue in the Big_Array.
ReDim Preserve _
small_array(1 To 2, 1 To LookUpValue_Counter)
'*******************************************
'NOTE: FOR THOSE OF YOU WHO HAVE BEEN TRYING TO _
FIND A WAY AROUND SUB-SETTING AN ARRAY THAT _
WORKS FOR WAY MORE THAN 65,536 ROWS (see index _
for sub-setting arrays) I FOUND A WAY :), NOTE THE _
2 to 2 IN THE FOR LOOP; THIS PULLS ONLY THE SECOND _
COLUMN OF THE ARRAY _
The following Starts a counter (j) to populate _
the small_array.
'*******************************************
For j = 2 To 2
'The small_array array equals the current Big_Array
small_array(j, LookUpValue_Counter) _
= Big_Array(i, j)
Next j
End If
Next i
'Transpose the small_array onto sheet
ActiveSheet.Range("C2", Range("C2").Offset(LookUpValue_Counter - 1, 1)) _
= Application.Transpose(small_array)
'Write LookUpValue to sheet
Worksheets("New TRAX").Cells(2, 3).Value2 = LookUpValue
Application.ScreenUpdating = True
End Sub
选项比较文本
选项显式
子测试GGG()
变暗大数组(),变小数组()
Dim i、j、LookUpValue_计数器的长度
作为字符串的Dim LookUpValue
Application.ScreenUpdating=False
'清除以前返回的数据
工作表(“新TRAX”).范围(“C2:D300”).清晰内容
如果UserForm2.txttablecols.Value为“”,则
LookUpValue=UserForm2.txttablecols.Value
其他的
MsgBox“您必须输入表名。”VBEQUOTE,“遇到错误”
出口接头
如果结束
'将cols A和B存储在Big_数组中
大数组=范围(“A2”)。当前区域
'从大数组循环的第二行开始_
大数组的每个元素
对于i=LBound(大数组,1)到UBound(大数组,1)
'注意:我在_
模块的开始部分,以生成文本_
比较不区分大小写
'这仅搜索第二列(即列名)
如果大数组(i,2)喜欢LookUpValue,那么
MsgBox“您必须输入表名,而不是列名”,VBEQUOTE,“遇到错误”
出口接头
'*******************************************************
“这就是给我带来问题的原因。就像我说的_
之前,如果我删除这个,其他代码和错误_
处理器工作完美。但是,如果用户_
输入不存在的表名,然后输入代码_
不会运行,但这是有意义的,b/c这就是错误所在_
handler是…除了它不起作用,哈哈。
'*******************************************************
这将仅搜索第一列(即表名)
如果不是(像LookUpValue一样的大数组(i,1),则
MsgBox“必须输入表的全名。”,VBEQUOTE,“遇到错误”
出口接头
'如果表名存在且格式正确_
格式化,然后执行以下操作
ElseIf Big_数组(i,1)类似于LookUpValue
'将LookUpValue_计数器每增加1_
查找值与列a中的值匹配的时间
LookUpValue\u计数器=LookUpValue\u计数器+1
'用每个实例重新确定小数组的尺寸_
在大数组中查找值的。
雷迪姆保护区_
小型_数组(1到2,1到LookUpValue_计数器)
'*******************************************
注:对于那些一直试图
找到一种方法来设置一个数组
适用于超过65536行(参见索引)
对于子设置数组),我找到了一种方法:),注意_
FOR循环中的2到2;这只拉了第二个_
数组的列_
下面启动一个计数器(j)来填充
小_阵列。
'*******************************************
对于j=2到2
'小数组等于当前大数组
小数组(j,LookUpValue\u计数器)_
=大_数组(i,j)
下一个j
如果结束
接下来我
'将小_数组转置到图纸上
活动表范围(“C2”,范围(“C2”)。偏移量(查找值\计数器-1,1))_
=应用程序.转置(小数组)
'将查找值写入工作表
工作表(“新TRAX”).单元格(2,3).Value2=查找值
Application.ScreenUpdating=True
端接头
我还尝试了以下方法:
ElseIf Not InStr(1, Big_Array(i, 1), LookUpValue, vbTextCompare) Then
ElseIf Big_Array(i, 1) <> LookUpValue Then
ElseIf Not (Big_Array(i, 1) = LookUpValue) Then
ElseIf Not InStr(1,大数组(i,1),LookUpValue,vbTextCompare),然后
ElseIf Big_数组(i,1)LookUpValue然后
ElseIf Not(大数组(i,1)=查找值)则
这些都不管用 在你开始写的时候
For i = LBound(Big_Array, 1) To UBound(Big_Array, 1)
后来你又哭了
ElseIf Not (Big_Array(i, 1) Like LookUpValue) Then
MsgBox "You must enter the the full name of the Table.", vbExclamation, "Error Encountered"
Option Compare Text
Option Explicit
Sub Testingggg()
Dim Big_Array(), small_array() As Variant
Dim i, j, LookUpValue_Counter As Long
' ***
Dim blnfound As Boolean
Dim LookUpValue As String
Application.ScreenUpdating = False
'Clear previously returned data
Worksheets("New TRAX").Range("C2:D300").ClearContents
If UserForm2.txttablecols.Value <> "" Then
LookUpValue = UserForm2.txttablecols.Value
Else
MsgBox "You must enter a the name of the table.", vbExclamation, "Error Encountered"
Exit Sub
End If
'Store cols A and B in the Big_Array
Big_Array = Range("A2").CurrentRegion
'Starting in the second row of the Big_Array loop through _
each element of the Big_Array
For i = LBound(Big_Array, 1) To UBound(Big_Array, 1)
'Note: I used Option Compare Text at the _
beginning of the module to make the text _
comparisons case insensitive
'This searches the second Col (i.e. Column Names) only
If Big_Array(i, 2) Like LookUpValue Then
MsgBox "You must enter the name of the Table, NOT the Column", vbExclamation, "Error Encountered"
Exit Sub
'If the table name exists and is in the correct _
format, then execute the following
ElseIf Big_Array(i, 1) Like LookUpValue Then
' ***
blnfound = True
'increase the LookUpValue_Counter by 1 each _
time the LookUpValue matches a value in col A
LookUpValue_Counter = LookUpValue_Counter + 1
'Redimension the small_array array with each instance _
of a the LookUpValue in the Big_Array.
ReDim Preserve _
small_array(1 To 2, 1 To LookUpValue_Counter)
'*******************************************
'NOTE: FOR THOSE OF YOU WHO HAVE BEEN TRYING TO _
FIND A WAY AROUND SUB-SETTING AN ARRAY THAT _
WORKS FOR WAY MORE THAN 65,536 ROWS (see index _
for sub-setting arrays) I FOUND A WAY :), NOTE THE _
2 to 2 IN THE FOR LOOP; THIS PULLS ONLY THE SECOND _
COLUMN OF THE ARRAY _
The following Starts a counter (j) to populate _
the small_array.
'*******************************************
For j = 2 To 2
'The small_array array equals the current Big_Array
small_array(j, LookUpValue_Counter) _
= Big_Array(i, j)
Next j
End If
Next i
' *** If no 'Like' was found
If blnfound = False Then
MsgBox "You must enter the the full name of the Table.", vbExclamation, "Error Encountered"
Exit Sub
End If
'Transpose the small_array onto sheet
ActiveSheet.Range("C2", Range("C2").Offset(LookUpValue_Counter - 1, 1)) _
= Application.Transpose(small_array)
'Write LookUpValue to sheet
Worksheets("New TRAX").Cells(2, 3).Value2 = LookUpValue
Application.ScreenUpdating = True
End Sub