Arrays 查找固定数组的所有值都存在的单元格

我有一个固定值的数组。如何在列B中找到包含数组中所有“字符串”值的单元格

这是我的密码

With Worksheets("Data")
    Dim kwrSets As Variant
    .Activate
    kwrSets = .Range("B2:B" & Application.WorksheetFunction.Max(2, .Range("A100000").End(xlUp).Row)).Value
    For k = LBound(kwrSets) To UBound(kwrSets)
        For i = LBound(arr) To UBound(arr)
            Delete entire row if all values of arr not found in kwrSets
        Next i
    Next k
End With

以下是基于以下答案的更新代码，但它在inStr行中给出了错误“下标超出范围”

Sub Extractor()
Dim ws As Worksheet, wsd As Worksheet
Dim cell As Variant
Dim tmp As Variant
Dim blnFound As Boolean
Dim j As Long, i As Long
Dim kwrSets() As Variant
Dim arr() As String

Set ws = Worksheets("Sheet1")
With ws
    .Activate
    For Each cell In .Range("A1:A" & .Cells(.Rows.Count, "B").End(xlUp).Row)
        If (cell.Offset(0, 2) = 1) Then
            tmp = tmp & cell & "|"
        End If
    Next cell
    If Len(tmp) > 0 Then tmp = Left(tmp, Len(tmp) - 1)
    arr = Split(tmp, "|")
End With

Set wsd = Worksheets("Data")
With wsd
    .Activate
    kwrSets = .Range("B2:B" & Application.WorksheetFunction.Max(2, .Range("A100000").End(xlUp).Row)).Value
    For k = LBound(kwrSets) To UBound(kwrSets)
        blnFound = True
        For i = LBound(arr) To UBound(arr)
            If InStr(kwrSets(j, 1), arr(i)) = 0 Then
                blnFound = False
                Exit For
            End If
        Next i
    Next k
End With

End Sub

---

下面是一些VBA代码，它将B列中的所有数据放入一个数组，然后循环此数组以检查搜索数组中是否存在每个元素。如果未找到任何搜索元素，则它将退出该循环。如果找到所有元素，则会高亮显示单元格

Sub sFindArray()
    Dim ws As Worksheet
    Dim aSearch() As Variant
    Dim aData() As Variant
    Dim lngLoop1 As Long
    Dim lngLoop2 As Long
    Dim lngFirstRow As Long
    Dim lngLastRow As Long
    Dim lngLBound As Long
    Dim lngUBound As Long
    Dim blnFound As Boolean
    aSearch = Array("a", "b", "c")
    lngLBound = LBound(aSearch)
    lngUBound = UBound(aSearch)
    Set ws = Worksheets("Sheet1")
    lngLastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    aData() = ws.Range("B1:B" & lngLastRow)
    lngFirstRow = LBound(aData, 1)
    lngLastRow = UBound(aData, 1)
    For lngLoop1 = lngFirstRow To lngLastRow
        blnFound = True
        For lngLoop2 = lngLBound To lngUBound
            If InStr(aData(lngLoop1, 1), aSearch(lngLoop2)) = 0 Then
                blnFound = False
                Exit For
            End If
        Next lngLoop2
        If blnFound = True Then
            ws.Cells(lngLoop1, 2).Interior.Color = vbRed
        End If
    Next lngLoop1
End Sub

---

关于，

我已经使用了您的代码来构建我的代码，但我在inStr行中遇到了错误。请检查我的原始帖子和更新。哦，我用的是j而不是k。现在解决了。感谢这就是为什么您应该在代码中始终使用

选项Explicit

——当您进行“编译”时，它会立即突出显示这一点。