VBA 在数组中搜索数组？ （检查一个数组的所有项目是否存在于另一个数组中）
VBA Search an array inside an array? (Check if all items of one array exists in another array)
是否可以在字符串 and/or 整数数组中查找字符串数组 and/or 整数？如果是，那又如何？
要在字符串数组中查找字符串，我使用如下代码：
If IsInArray(LowerFilmWidthArray, LowerFilmWidth) then
'Dos tuff
end if
一个函数是：
Function IsInArray(arr As Variant, myVal As Variant) As Boolean
IsInArray = Not IsError(Application.Match(myVal, arr, 0))
Debug.Print (IsInArray)
End Function
作为结果示例，假设您有一个整数数组 (1-10)，并且您正在查看您的数组 (1,5,6) 是否在前一个数组（它的所有项）内，然后 return 没错。在我的例子中，我正在寻找从第 3 列到最后一列数据的列中的值，这将构成我的数组，我试图在另一个数组中找到所有项目并且 return true 或 false。
实际例子：
Dim LowerFilmWidthArray
LowerFilmWidthArray = Application.Transpose(Evaluate("row(320:420)"))
Dim LowerFilmWidth As Integer
LowerFilmWidth = Array(ThisWorkbook.Worksheets("Machine Specification").Cells(320, 400,400,620)
'I get theese from a range and they might as well be strings and an undefined number of defined by 3 to last column with data
if isinarray(LowerFilmWidthArray,LowerFilmWidth) then
msgbox("Great Success!")
end if
由于最后一个“620”不在 LowerFilmWidthArray 内，因此此结果为假。
已编辑：
仍然无法让它工作，我的直觉告诉我答案中有太多不必要的东西，而我只需要从数组中取出每一项并尝试在另一个数组中找到它并得到“TRUE”仅当我要查找的所有项目都存在于一个大数组中时。
我已转换为查找数组（较小的数组）以获取设定范围内的值，该范围始终是从 3 到最后一列的一行。
Dim LowerFilmWidth
LowerFilmWidth = ThisWorkbook.Worksheets("Machine Specification").Range(Cells(Cells.Find("Lower Film Width (mm)").Row, 3), Cells(Cells.Find("Lower Film Width (mm)").Row, LastColumn))
而且我希望这部分能够生成该范围内单元格中所有值的数组。现在我需要查看是否所有这些项目/元素都存在于：
Dim LowerFilmWidthArray
LowerFilmWidthArray = Application.Transpose(Evaluate("row(320:420)"))
所以我使用建议的函数：
Function arrElemInArray(arr As Variant, arrX As Variant) As Boolean
Dim i As Long, j As Long, boolFound As Boolean
For i = LBound(arrX) To UBound(arrX)
For j = LBound(arr) To UBound(arr)
If CStr(arr(j)) = CStr(arrX(i)) Then
boolFound = True: Exit For
End If
If Not boolFound Then arrElemInArray = False: Exit Function
Next j
Next i
arrElemInArray = True
Debug.Print (arrElemInArray)
End Function
并使用
参与其中
If arrElemInArray(LowerFilmWidthArray, LowerFilmWidth) Then
msgbox("Great success!")
End If
解决方案必须同时适用于整数和字符串。我仍然无法让它按预期工作。通常它 return 无论如何都是“真”，但它似乎只检查较小数组中的第一项与大数组。
此代码在编辑 return“CStr(arrX(i))”上出现“下标超出范围”错误。
完整的子例程如下所示：
Sub Testing()
Dim LastColumn As Long
LastColumn = Cells(Cells.Find("Parameters", lookat:=xlWhole).Row, Columns.Count).End(xlToLeft).Column
Dim LowerFilmWidth
LowerFilmWidth = ThisWorkbook.Worksheets("Machine Specification").Range(Cells(Cells.Find("Lower Film Width (mm)").Row, 3), Cells(Cells.Find("Lower Film Width (mm)").Row, LastColumn))
Dim LowerFilmWidthArray
LowerFilmWidthArray = Application.Transpose(Evaluate("row(320:420)"))
If arrElemInArray(LowerFilmWidthArray, LowerFilmWidth) Then
MsgBox ("Great success!")
End If
End Sub
数组是数组中的数组
个性化研究
- 将包含值的单元格的数字格式更改为通用格式或数字格式以使其生效。
Option Explicit
Sub Testing()
Const sHeader As String = "Parameters"
Const sProperty As String = "Lower Film Width (mm)"
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim ws As Worksheet: Set ws = wb.Worksheets("Machine Specification")
' Reference the last cell of the used range.
Dim LastCell As Range
With ws.UsedRange
Set LastCell = .Cells(.Rows.Count, .Columns.Count)
Debug.Print "UsedRange: " & .Address(0, 0)
Debug.Print "LastCell: " & LastCell.Address(0, 0)
End With
' Reference the header cell.
Dim HeaderCell As Range
Set HeaderCell = ws.Cells.Find(sHeader, LastCell, xlFormulas, xlWhole)
If HeaderCell Is Nothing Then Exit Sub ' header not found
Debug.Print "HeaderCell: " & HeaderCell.Address(0, 0)
' Calculate the first column number.
Dim FirstColumn As Long: FirstColumn = HeaderCell.Column + 1
Debug.Print "FirstColumn: " & FirstColumn
' Calculate the last column number.
Dim LastColumn As Long: LastColumn = _
ws.Cells(HeaderCell.Row, ws.Columns.Count).End(xlToLeft).Column
If LastColumn < FirstColumn Then Exit Sub ' no data to the right of header
Debug.Print "LastColumn: " & LastColumn
' Reference the column range below the header cell
' to search for the property.
Dim sDataColumnRange As Range ' below the header
Set sDataColumnRange _
= HeaderCell.Resize(LastCell.Row - HeaderCell.Row).Offset(1)
Debug.Print "sDataColumnRange: " & sDataColumnRange.Address(0, 0); ""
' Reference the property cell.
Dim sPropertyCell As Range
With sDataColumnRange
Set sPropertyCell _
= .Find(sProperty, .Cells(.Rows.Count), xlFormulas, xlWhole)
If sPropertyCell Is Nothing Then Exit Sub ' property not found
Debug.Print "sPropertyCell: " & sPropertyCell.Address(0, 0)
End With
' Reference the property (values) row range (first to last column).
Dim PropertyRowRange As Range
Set PropertyRowRange = ws.Range(ws.Cells(sPropertyCell.Row, FirstColumn), _
ws.Cells(sPropertyCell.Row, LastColumn))
Debug.Print "PropertyRowRange: " & PropertyRowRange.Address(0, 0)
Debug.Print "PropertyRowRange Values" & vbLf & Join(Application.Transpose( _
Application.Transpose(PropertyRowRange.Value)), ", ")
' Populate the property values array.
Dim PropertyValuesArray As Variant
PropertyValuesArray = Application.Transpose(Evaluate("Row(320:420)"))
Debug.Print "PropertyValuesArray Values"
Debug.Print Join(PropertyValuesArray, ", ")
' Return the result whether all values of the property row range
' are found in the property values array.
If IsRowInArr(PropertyValuesArray, PropertyRowRange) Then
MsgBox "All matching.", vbInformation
Debug.Print "All matching."
Else
MsgBox "Not all matching.", vbCritical
Debug.Print "Not all matching."
End If
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Returns a boolean indicating whether a 1D array ('InArr')
' contains all values in a row ('RowIndex')
' of a range ('IsRange').
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function IsRowInArr( _
ByVal InArr As Variant, _
ByVal IsRange As Range, _
Optional ByVal RowIndex As Long = 1) _
As Boolean
Const ProcName As String = "IsRowInArr"
On Error GoTo ClearError
With IsRange.Rows(RowIndex)
Dim cCount As Long: cCount = .Columns.Count
If cCount = 1 Then
IsRowInArr = IsNumeric(Application.Match(.Value, InArr, 0))
Else
Dim IsRow As Variant: IsRow = .Value
IsRowInArr = Application.Count(Application.Match( _
IsRow, InArr, 0)) = cCount
End If
End With
ProcExit:
Exit Function
ClearError:
Debug.Print "'" & ProcName & "' Run-time error '" _
& Err.Number & "':" & vbLf & " " & Err.Description
Resume ProcExit
End Function
初始答案
- 如果在另一个数组 (
InArr) 中找到一个数组 (IsArr) 的所有元素，该函数将 return 为真。
Option Explicit
Sub IsArrayInArrayTEST()
Dim InArr As Variant: InArr = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
Dim IsArr As Variant
IsArr = Array(1)
Debug.Print IsArrayInArray(IsArr, InArr) ' True
IsArr = Array(1, 5, 11)
Debug.Print IsArrayInArray(IsArr, InArr) ' False
End Sub
Function IsArrayInArray( _
ByVal IsArr As Variant, _
ByVal InArr As Variant) _
As Boolean
Dim IsCount As Long: IsCount = UBound(IsArr) - LBound(IsArr) + 1
Dim rArr As Variant: rArr = Application.Match(IsArr, InArr, 0)
Dim rCount As Long: rCount = Application.Count(rArr)
'Debug.Print rCount, IsCount
If rCount = IsCount Then
IsArrayInArray = True
End If
End Function
请看下一个例子。这是您想要完成的吗？
Sub testArrInArr()
Dim arr(), arr1(), arr2(), arr3(), arr4()
arr1 = Array(1, 2, 3): arr2 = Array(2, 3, 4)
arr3 = Array(3, 6, 5, 4): arr4 = Array(4, 5, 6)
arr = Array(arr1, arr2, arr3)
Debug.Print arrIsInArray(arr, arr2)
End Sub
Function arrIsInArray(arr As Variant, arrX As Variant) As Boolean
Dim i As Long, jArr As String
For i = LBound(arr) To UBound(arr)
If Join(arr(i)) = Join(arrX) Then arrIsInArray = True: Exit Function
Next i
End Function
已编辑:
为了测试每个数组元素如果存在于另一个数组中，请尝试下一种方式：
Sub tst2CheckArrElements()
Dim arr, arr1, arr2
arr = Split("1,2,3,4,5", ","): arr1 = Split("Sausage,Dog,Ship", ","): arr2 = Split("1,3,2", ",")
Debug.Print arrElemInArray(arr, arr1)
Debug.Print arrElemInArray(arr, arr2)
End Sub
Function arrElemInArray(arr As Variant, arrX As Variant) As Boolean
Dim i As Long, j As Long, boolFound As Boolean, mtch
If Not IsArray(arrX) Then
For j = LBound(arr) To UBound(arr)
If CStr(arr(j)) = CStr(arrX) Then arrElemInArray = True: Exit For
Next j
Exit Function
End If
For i = LBound(arrX) To UBound(arrX, 2)
For j = LBound(arr) To UBound(arr)
If CStr(arr(j)) = CStr(arrX(1, i)) Then
boolFound = True: Exit For
End If
Next j
If Not boolFound Then arrElemInArray = False: Exit Function
boolFound = False
Next i
arrElemInArray = True
End Function
是否可以在字符串 and/or 整数数组中查找字符串数组 and/or 整数？如果是，那又如何？
要在字符串数组中查找字符串，我使用如下代码：
If IsInArray(LowerFilmWidthArray, LowerFilmWidth) then
'Dos tuff
end if
一个函数是：
Function IsInArray(arr As Variant, myVal As Variant) As Boolean
IsInArray = Not IsError(Application.Match(myVal, arr, 0))
Debug.Print (IsInArray)
End Function
作为结果示例，假设您有一个整数数组 (1-10)，并且您正在查看您的数组 (1,5,6) 是否在前一个数组（它的所有项）内，然后 return 没错。在我的例子中，我正在寻找从第 3 列到最后一列数据的列中的值，这将构成我的数组，我试图在另一个数组中找到所有项目并且 return true 或 false。
实际例子：
Dim LowerFilmWidthArray
LowerFilmWidthArray = Application.Transpose(Evaluate("row(320:420)"))
Dim LowerFilmWidth As Integer
LowerFilmWidth = Array(ThisWorkbook.Worksheets("Machine Specification").Cells(320, 400,400,620)
'I get theese from a range and they might as well be strings and an undefined number of defined by 3 to last column with data
if isinarray(LowerFilmWidthArray,LowerFilmWidth) then
msgbox("Great Success!")
end if
由于最后一个“620”不在 LowerFilmWidthArray 内，因此此结果为假。
已编辑：
仍然无法让它工作，我的直觉告诉我答案中有太多不必要的东西，而我只需要从数组中取出每一项并尝试在另一个数组中找到它并得到“TRUE”仅当我要查找的所有项目都存在于一个大数组中时。
我已转换为查找数组（较小的数组）以获取设定范围内的值，该范围始终是从 3 到最后一列的一行。
Dim LowerFilmWidth
LowerFilmWidth = ThisWorkbook.Worksheets("Machine Specification").Range(Cells(Cells.Find("Lower Film Width (mm)").Row, 3), Cells(Cells.Find("Lower Film Width (mm)").Row, LastColumn))
而且我希望这部分能够生成该范围内单元格中所有值的数组。现在我需要查看是否所有这些项目/元素都存在于：
Dim LowerFilmWidthArray
LowerFilmWidthArray = Application.Transpose(Evaluate("row(320:420)"))
所以我使用建议的函数：
Function arrElemInArray(arr As Variant, arrX As Variant) As Boolean
Dim i As Long, j As Long, boolFound As Boolean
For i = LBound(arrX) To UBound(arrX)
For j = LBound(arr) To UBound(arr)
If CStr(arr(j)) = CStr(arrX(i)) Then
boolFound = True: Exit For
End If
If Not boolFound Then arrElemInArray = False: Exit Function
Next j
Next i
arrElemInArray = True
Debug.Print (arrElemInArray)
End Function
并使用
参与其中If arrElemInArray(LowerFilmWidthArray, LowerFilmWidth) Then
msgbox("Great success!")
End If
解决方案必须同时适用于整数和字符串。我仍然无法让它按预期工作。通常它 return 无论如何都是“真”，但它似乎只检查较小数组中的第一项与大数组。
此代码在编辑 return“CStr(arrX(i))”上出现“下标超出范围”错误。
完整的子例程如下所示：
Sub Testing()
Dim LastColumn As Long
LastColumn = Cells(Cells.Find("Parameters", lookat:=xlWhole).Row, Columns.Count).End(xlToLeft).Column
Dim LowerFilmWidth
LowerFilmWidth = ThisWorkbook.Worksheets("Machine Specification").Range(Cells(Cells.Find("Lower Film Width (mm)").Row, 3), Cells(Cells.Find("Lower Film Width (mm)").Row, LastColumn))
Dim LowerFilmWidthArray
LowerFilmWidthArray = Application.Transpose(Evaluate("row(320:420)"))
If arrElemInArray(LowerFilmWidthArray, LowerFilmWidth) Then
MsgBox ("Great success!")
End If
End Sub
数组是数组中的数组
个性化研究
- 将包含值的单元格的数字格式更改为通用格式或数字格式以使其生效。
Option Explicit
Sub Testing()
Const sHeader As String = "Parameters"
Const sProperty As String = "Lower Film Width (mm)"
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim ws As Worksheet: Set ws = wb.Worksheets("Machine Specification")
' Reference the last cell of the used range.
Dim LastCell As Range
With ws.UsedRange
Set LastCell = .Cells(.Rows.Count, .Columns.Count)
Debug.Print "UsedRange: " & .Address(0, 0)
Debug.Print "LastCell: " & LastCell.Address(0, 0)
End With
' Reference the header cell.
Dim HeaderCell As Range
Set HeaderCell = ws.Cells.Find(sHeader, LastCell, xlFormulas, xlWhole)
If HeaderCell Is Nothing Then Exit Sub ' header not found
Debug.Print "HeaderCell: " & HeaderCell.Address(0, 0)
' Calculate the first column number.
Dim FirstColumn As Long: FirstColumn = HeaderCell.Column + 1
Debug.Print "FirstColumn: " & FirstColumn
' Calculate the last column number.
Dim LastColumn As Long: LastColumn = _
ws.Cells(HeaderCell.Row, ws.Columns.Count).End(xlToLeft).Column
If LastColumn < FirstColumn Then Exit Sub ' no data to the right of header
Debug.Print "LastColumn: " & LastColumn
' Reference the column range below the header cell
' to search for the property.
Dim sDataColumnRange As Range ' below the header
Set sDataColumnRange _
= HeaderCell.Resize(LastCell.Row - HeaderCell.Row).Offset(1)
Debug.Print "sDataColumnRange: " & sDataColumnRange.Address(0, 0); ""
' Reference the property cell.
Dim sPropertyCell As Range
With sDataColumnRange
Set sPropertyCell _
= .Find(sProperty, .Cells(.Rows.Count), xlFormulas, xlWhole)
If sPropertyCell Is Nothing Then Exit Sub ' property not found
Debug.Print "sPropertyCell: " & sPropertyCell.Address(0, 0)
End With
' Reference the property (values) row range (first to last column).
Dim PropertyRowRange As Range
Set PropertyRowRange = ws.Range(ws.Cells(sPropertyCell.Row, FirstColumn), _
ws.Cells(sPropertyCell.Row, LastColumn))
Debug.Print "PropertyRowRange: " & PropertyRowRange.Address(0, 0)
Debug.Print "PropertyRowRange Values" & vbLf & Join(Application.Transpose( _
Application.Transpose(PropertyRowRange.Value)), ", ")
' Populate the property values array.
Dim PropertyValuesArray As Variant
PropertyValuesArray = Application.Transpose(Evaluate("Row(320:420)"))
Debug.Print "PropertyValuesArray Values"
Debug.Print Join(PropertyValuesArray, ", ")
' Return the result whether all values of the property row range
' are found in the property values array.
If IsRowInArr(PropertyValuesArray, PropertyRowRange) Then
MsgBox "All matching.", vbInformation
Debug.Print "All matching."
Else
MsgBox "Not all matching.", vbCritical
Debug.Print "Not all matching."
End If
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Returns a boolean indicating whether a 1D array ('InArr')
' contains all values in a row ('RowIndex')
' of a range ('IsRange').
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function IsRowInArr( _
ByVal InArr As Variant, _
ByVal IsRange As Range, _
Optional ByVal RowIndex As Long = 1) _
As Boolean
Const ProcName As String = "IsRowInArr"
On Error GoTo ClearError
With IsRange.Rows(RowIndex)
Dim cCount As Long: cCount = .Columns.Count
If cCount = 1 Then
IsRowInArr = IsNumeric(Application.Match(.Value, InArr, 0))
Else
Dim IsRow As Variant: IsRow = .Value
IsRowInArr = Application.Count(Application.Match( _
IsRow, InArr, 0)) = cCount
End If
End With
ProcExit:
Exit Function
ClearError:
Debug.Print "'" & ProcName & "' Run-time error '" _
& Err.Number & "':" & vbLf & " " & Err.Description
Resume ProcExit
End Function
初始答案
- 如果在另一个数组 (
InArr) 中找到一个数组 (IsArr) 的所有元素，该函数将 return 为真。
Option Explicit
Sub IsArrayInArrayTEST()
Dim InArr As Variant: InArr = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
Dim IsArr As Variant
IsArr = Array(1)
Debug.Print IsArrayInArray(IsArr, InArr) ' True
IsArr = Array(1, 5, 11)
Debug.Print IsArrayInArray(IsArr, InArr) ' False
End Sub
Function IsArrayInArray( _
ByVal IsArr As Variant, _
ByVal InArr As Variant) _
As Boolean
Dim IsCount As Long: IsCount = UBound(IsArr) - LBound(IsArr) + 1
Dim rArr As Variant: rArr = Application.Match(IsArr, InArr, 0)
Dim rCount As Long: rCount = Application.Count(rArr)
'Debug.Print rCount, IsCount
If rCount = IsCount Then
IsArrayInArray = True
End If
End Function
请看下一个例子。这是您想要完成的吗？
Sub testArrInArr()
Dim arr(), arr1(), arr2(), arr3(), arr4()
arr1 = Array(1, 2, 3): arr2 = Array(2, 3, 4)
arr3 = Array(3, 6, 5, 4): arr4 = Array(4, 5, 6)
arr = Array(arr1, arr2, arr3)
Debug.Print arrIsInArray(arr, arr2)
End Sub
Function arrIsInArray(arr As Variant, arrX As Variant) As Boolean
Dim i As Long, jArr As String
For i = LBound(arr) To UBound(arr)
If Join(arr(i)) = Join(arrX) Then arrIsInArray = True: Exit Function
Next i
End Function
已编辑:
为了测试每个数组元素如果存在于另一个数组中，请尝试下一种方式：
Sub tst2CheckArrElements()
Dim arr, arr1, arr2
arr = Split("1,2,3,4,5", ","): arr1 = Split("Sausage,Dog,Ship", ","): arr2 = Split("1,3,2", ",")
Debug.Print arrElemInArray(arr, arr1)
Debug.Print arrElemInArray(arr, arr2)
End Sub
Function arrElemInArray(arr As Variant, arrX As Variant) As Boolean
Dim i As Long, j As Long, boolFound As Boolean, mtch
If Not IsArray(arrX) Then
For j = LBound(arr) To UBound(arr)
If CStr(arr(j)) = CStr(arrX) Then arrElemInArray = True: Exit For
Next j
Exit Function
End If
For i = LBound(arrX) To UBound(arrX, 2)
For j = LBound(arr) To UBound(arr)
If CStr(arr(j)) = CStr(arrX(1, i)) Then
boolFound = True: Exit For
End If
Next j
If Not boolFound Then arrElemInArray = False: Exit Function
boolFound = False
Next i
arrElemInArray = True
End Function