[英]Finding if a string is in a 2 dimensional VBA Excel array
I have a great function that I use all of the time for a 1 dimensional Excel VBA array that checks if a string is in an array: 我有一个很棒的功能,我一直用于一维Excel VBA数组,检查字符串是否在数组中:
Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
IsInArray = (UBound(Filter(arr(), stringToBeFound)) > -1)
End Function
Unfortunately it does not work when using it to check for a 2 dimensional array, like I have here: 不幸的是,当它用于检查二维数组时,它不起作用,就像我在这里:
Sub new_idea_filter()
home_sheet = ActiveSheet.Name
c = 1
Dim myfilters(1 To 4, 1 To 5000)
myfilters(1, 4) = "Test"
If IsInArray("Test", myfilters()) = True Then
killer = True
End If
End Sub
Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
IsInArray = (UBound(Filter(arr(), stringToBeFound)) > -1)
End Function
It keeps erroring out in the function saying subscript out of range, anyone have a thought how I can check if a string is in the 2 dimensional array? 它在下标超出范围的函数中不断出错,任何人都在考虑如何检查字符串是否在二维数组中?
Something from my code collection 我的代码集中的东西
You can use Application.Match
. 您可以使用Application.Match
。 This will work for both 1D
and 2D
array :) 这适用于1D
和2D
阵列:)
See this 看到这个
Sub Sample()
Dim myfilters(1 To 4, 1 To 5000)
myfilters(1, 4) = "Test"
If IsInArray("Test", myfilters()) = True Then MsgBox "Found"
End Sub
Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
Dim bDimen As Byte, i As Long
On Error Resume Next
If IsError(UBound(arr, 2)) Then bDimen = 1 Else bDimen = 2
On Error GoTo 0
Select Case bDimen
Case 1
On Error Resume Next
IsInArray = Application.Match(stringToBeFound, arr, 0)
On Error GoTo 0
Case 2
For i = 1 To UBound(arr, 2)
On Error Resume Next
IsInArray = Application.Match(stringToBeFound, Application.Index(arr, , i), 0)
On Error GoTo 0
If IsInArray = True Then Exit For
Next
End Select
End Function
As long as you're in Excel (or have a reference to it), you can use the Index function to slice your array into rows or columns. 只要您在Excel中(或具有对它的引用),就可以使用Index函数将数组切片为行或列。
Public Function IsInArray(ByVal vToFind As Variant, vArr As Variant) As Boolean
Dim i As Long
Dim bReturn As Boolean
Dim vLine As Variant
For i = LBound(vArr, 1) To UBound(vArr, 1)
vLine = Application.WorksheetFunction.Index(vArr, i) 'slice off one line
If IsArray(vLine) Then 'if it's an array, use the filter
bReturn = UBound(Filter(vLine, vToFind)) > -1
Else 'if it's not an array, it was 1d so check the value
bReturn = vLine = vToFind
End If
If bReturn Then Exit For 'stop looking if one found
Next i
IsInArray = bReturn
End Function
Public Sub test()
Dim arr() As Variant
ReDim arr(1 To 2, 1 To 2)
arr(1, 2) = "Test"
Debug.Assert IsInArray("Test", arr)
arr(1, 2) = "Wrong"
Debug.Assert Not IsInArray("Test", arr)
ReDim arr(1 To 3)
arr(2) = "Test"
Debug.Assert IsInArray("Test", arr)
arr(2) = "Wrong"
Debug.Assert Not IsInArray("Test", arr)
Debug.Print "Passed"
End Sub
If you get the data from a recordset i use this method; 如果从记录集中获取数据,我使用此方法; first i use GetString for the recordset, second use Split to convert the string in a array unidimensional where each item is a string with all the information. 首先我使用GetString作为记录集,第二次使用Split将数组中的字符串转换为单维数据,其中每个项目都是包含所有信息的字符串。 After that you con use the function IsInArray. 之后,您可以使用函数IsInArray。
The code is: 代码是:
RecSet.Open strSQL, Cn
RecSet.MoveFirst
RecString = RecSet.GetString(, , ";", vbCr) 'genera una cadena con los datos. Campos separados por ; y registros por vbCR
RecSplit = Split(RecString, vbCr) 'Genera un array unidimensional con la cadena
you can test the code, but remember only works if you get the data from a recordset 您可以测试代码,但请记住只有从记录集中获取数据才有效
You can try converting your original Function to be able to work with arrays. 您可以尝试转换原始函数以便能够使用数组。 Please try the following, though note that I have not tested if it works. 请尝试以下操作,但请注意我没有测试它是否有效。
Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
Dim cell As Variant
For Each cell In arr
IsInArray = IsInArray Or (UBound(Filter(cell(), stringToBeFound)) > -1)
Next
End Function
Regards 问候
@Siddharth-Rout answer above is working perfectly with Application.Match
in addition to the Filter
function :-). 除了Filter
函数之外,@ Siddharth-Rout上面的答案与Application.Match
完美配合:-)。 - My solution tries to use the OP Filter
function only: As the filter function needs a 1dim array, the array is splitted into portions. - 我的解决方案只尝试使用OP Filter
函数:由于filter函数需要1dim数组,因此数组被分成几部分。
A) Alternative solution using the original FILTER function instead of Match plus error handling A)使用原始FILTER函数而不是Match plus错误处理的替代解决方案
Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
Dim i As Long
If nDim(arr) = 1 Then
IsInArray = (UBound(Filter(arr(), stringToBeFound)) > -1)
Else ' allows using filter function in portions
For i = 1 To UBound(arr, 2)
If (UBound(Filter(Application.Transpose(Application.Index(arr, 0, i)), stringToBeFound)) > -1) Then IsInArray = True: Exit For
Next i
End If
End Function
Helper function to get array Dimension Helper函数获取数组Dimension
Function nDim(ByVal vArray As Variant) As Long
' Purp: get number of array dimensions
' Site: http://support.microsoft.com/kb/152288
Dim dimnum As Long
Dim ErrorCheck As Variant
On Error GoTo FinalDimension
For dimnum = 1 To 60000
ErrorCheck = LBound(vArray, dimnum)
Next
FinalDimension:
nDim = dimnum - 1
End Function
B) Recursive solution using the original FILTER function instead of Match plus error handling B)使用原始FILTER函数而不是Match plus错误处理的递归解决方案
Function IsInArray(stringToBeFound As String, arr As Variant, Optional i As Long = 0) As Boolean
Select Case i
Case -1: ' stop 2dim calls
Case 0: IsInArray = IsInArray(stringToBeFound, arr, nDim(arr)) ' start recursive call
Case 1: IsInArray = (UBound(Filter(arr(), stringToBeFound)) > -1) ' 1dim array
Case Else ' allows using filter function in portions
If (UBound(Filter(Application.Transpose(Application.Index(arr, 0, i)), stringToBeFound)) > -1) Then
IsInArray = True
Else ' recursive calls (2dim array)
IsInArray = IsInArray(stringToBeFound, arr, IIf(i + 1 > UBound(arr), -1, i + 1))
End If
End Select
End Function
I have an Excel users version solution for this as well. 我也有一个Excel用户版本的解决方案。
Cant you just split concatenate the array into a single column (1-d array)? 你不能将数组连接成一个列(1-d数组)? you got x columns. 你有x列。 who cares about the # of rows for now. 谁现在关心行数#
I would do : col 1 & "/// unique character delimiter"& col#1 & col 2 & "/// unique character delimiter"& col#2 & col 3 & "/// unique character delimiter"& col#2 & ... & & col (n-1) & "/// unique character delimiter"& col#(n-1) & & "/// unique character delimiter"& col#n 我会这样做:col 1&“/// unique character delimiter”&col#1&col 2&“/// unique character delimiter”&col#2&col 3&“/// unique character delimiter”&col# 2&... && col(n-1)&“/// unique character delimiter”&col#(n-1)&&“/// unique character delimiter”&col#n
turning the 2-d array into a 1-d array. 将2-d阵列转换为1-d阵列。
and index match this joined-up array/column, to find the multiple occurances of the string located in the original array. 和index匹配此连接的数组/列,以查找位于原始数组中的字符串的多次出现。
And whats good about this, because of the unique way you joined it (any unique delimator charavter + col# ) it can and will also tell you the original column each found return value of the string your looking for resided in. SO you dont loose any information. 并且有什么好处,因为你加入它的独特方式(任何独特的delimator charavter + col#)它可以并且还会告诉你原始列每个找到你寻找的字符串的返回值。所以你不要松动任何信息。
(you can do that implementing =match ("/"&string&"/")) the position of the looked-for text in the lookup output and the next occurrence of the special unique delimiter & the next (subsequent) col # that's to the right of it. (你可以这样做实现= match(“/”&string&“/”))查找输出中查找文本的位置以及下一次出现的特殊唯一分隔符和下一个(后续)col#它的权利。
Doesn't this do the same thing , as the macros above or the question asks for ? 这不是同样的事情,因为上面的宏或问题要求? and in an (almost) non-macro*/non-vba way? 并以(几乎)非宏* /非vba方式?
*see below for why it can be done with out without macros. *请参阅下文,了解为什么可以在没有宏的情况下完成。
So in the end, you can just turn any 2-d NM array into an 1-d X array, while keeping all the information (of which column the text was originally belonging to) and still do a simple lookup, index-match or a LoopALL function (which is great) : 所以最后,您可以将任何2维NM阵列转换为1-D X阵列,同时保留所有信息(文本最初所属的列),并且仍然可以进行简单的查找,索引匹配或一个LoopALL函数(很棒):
Lookupall macro to use to find and return multiple found occurrences of string: Lookupall宏用于查找和返回多个找到的字符串:
Function LookupAll(vVal, rTable As Range, ColumnI As Long) As Variant
Dim rFound As Range, lLoop As Long
Dim strResults As String
With rTable.Columns(1)
Set rFound = .Cells(1, 1)
For lLoop = 1 To WorksheetFunction.CountIf(.Cells, vVal)
Set rFound = .Find(what:=vVal, After:=rFound, LookIn:=xlFormulas, lookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
strResults = strResults & "," & rFound(1, ColumnI)
Next lLoop
End With
LookupAll = Trim(Right(strResults, Len(strResults) - 1))
End Function
Up to you whether you use VBA lookup all function above or an index-match formula in excel which can find and return multiple occurrences of a search find. 取决于您是否使用上面的VBA查找所有函数或excel中的索引匹配公式,它可以查找并返回多次出现的搜索查找。
Delimation and join of separate columns of an array strips a need for an array search (which I've never been able to do as I wanted - ie. get the results all into 1 cell), and turns it into a single and simpler 1-d array without any information loss. 数组的单独列的缩放和连接剥离了数组搜索的需要(我从未能够按照我想要的那样做 - 即将结果全部放入1个单元格中),并将其转换为单个且更简单的1 -d数组没有任何信息丢失。
I believe the speed would be as fast (and accurate) as anything else. 我相信速度和其他任何东西一样快(和准确)。 Particularly as you've reduced/condensed the array into a single array - 1 column. 特别是当您将阵列缩减/压缩成单个阵列时 - 1列。
Any thoughts? 有什么想法吗?
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.