VBA 在数组中搜索数组？ （检查一个数组的所有项是否存在于另一个数组中）

Question

是否可以在字符串和/或整数数组中查找字符串和/或整数数组？如果是，那怎么办？

要在字符串数组中查找字符串，我使用如下代码：

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) 是否在前一个数组（其中的所有项）内，然后返回 True。在我的情况下，我正在全力寻找从第 3 列到最后一列的数据列中的值，这将构成我的数组，我尝试在另一个数组中查找所有项目并返回 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

解决方案必须同时使用整数和字符串。我仍然无法让它按预期工作。通常它无论如何都会返回“True”，但它似乎只检查较小数组中的第一项与大数组。

编辑中的此代码在“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

工作簿： enter link description here

Answer 1

请看下一个例子。这是您尝试完成的任务吗？

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

Answer 2

是数组中的数组

个性化研究

• 将包含值的单元格的数字格式更改为一般格式或数字格式以使其正常工作。

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) 的所有元素，则该函数将返回 true。

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