将单元格值与数组内容进行比较

Question

我的目标是检查一列是否每个单元格都包含（除了其他值之外）我数组中的一个字母。

细胞看起来像“123A”。
我的数组包含值 A、C、D、X、Y、Z。
两者都只是示例值。
请注意，如果单元格包含任何字母，我的 if 语句应该为真，因此对于示例，它应该为真。
对于单元格值“123B”，它应该为 false（数组中没有 B）。

我发现了一个“IsinArray”函数，它似乎正在工作，但会检查特定值。

我需要的是更接近 ---> "*" & IsinArray & "*"

我找到的函数是这样的：

Public Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
  IsInArray = Not IsError(Application.Match(stringToBeFound, arr, 0))
End Function

我的循环列的 For 语句也在工作（我会说 ^^）

如果您对如何做得更好有任何想法，我也愿意接受“创造性”解决方案。

Answer 1

试试，

Public Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
    Dim s As String, i As Integer
    Dim a As Variant
    For i = 1 To Len(stringToBeFound)
        s = Mid(stringToBeFound, i, 1)
        For Each a In arr
            If s = a Then
                IsInArray = True
                Exit Function
            End If
        Next a
    Next i
End Function

Answer 2

你可以把它转过来

Option Explicit

Public Sub Test()
    Dim testArray(), cellValue As String, rng As Range
    Set rng = ThisWorkbook.Worksheets("Sheet1").Range("A1")    '<== contains
    testArray = Array("A", "C", "D", "X", "Y", "Z")
    Debug.Print IsInArrayValue(testArray, rng)
End Sub

Public Function IsInArrayValue(ByVal testArray As Variant, ByVal rng As Range) As Variant
    Dim i As Long, testString As String
    testString = rng.Text
    If rng.Cells.Count > 1 Then
        IsInArrayValue = CVErr(xlErrNA)
        Exit Function
    End If
    For i = LBound(testArray) To UBound(testArray)

        If InStr(testString, testArray(i)) > 0 Then
            IsInArrayValue = True
            Exit Function
        End If
    Next
    IsInArrayValue = False
End Function

---

如果用作 UDF，您可以如上所示传递数组，或者如果数组没有改变，您可以移入函数本身。就个人而言，我更喜欢将数组作为参数传递给函数，因为它更灵活。我无法弄清楚你要复制的行来自哪里。您作为答案发布的评论使用了一个 j 变量，该变量似乎没有参与显示的循环，并且该行是从另一张表中复制的。所以下面不会直接工作，而是给你一个框架。

Public Function IsInArrayValue(ByVal rng As Range) As Variant
    Dim i As Long, testString As String, testArray()
    testArray = Array("A", "C", "D", "X", "Y", "Z")
    testString = rng.Text
    If rng.Cells.Count > 1 Then
        IsInArrayValue CVErr(xlErrNA)
        Exit Function
    End If
    For i = LBound(testArray) To UBound(testArray)

        If InStr(testString, testArray(i)) > 0 Then
            IsInArrayValue = True
            Exit Function
        End If
    Next
    IsInArrayValue = False
End Function

呼叫：

---

下面的评论看起来像是一个新问题，但您可能想要这样的问题：

Dim loopRange As Range, rng As Range

With ThisWorkbook.Worksheets("Filter")
    Set loopRange = .Range(.Cells(1, VarNutzerSpalte), .Cells(VarAnzahlZeilen, VarNutzerSpalte))
End With

For Each rng In loopRange
   If IsInArrayValue(ArrAuswahlNutzer, rng) Then
       rng.EntireRow.Copy  '<= use Union to gather range if all being pasted in a block somewhere
   End If
Next

联合版本可能如下所示：

Dim loopRange As Range, rng As Range, unionRng As Range

With ThisWorkbook.Worksheets("Filter")
    Set loopRange = .Range(.Cells(1, VarNutzerSpalte), .Cells(VarAnzahlZeilen, VarNutzerSpalte))
End With

For Each rng In loopRange
   If IsInArrayValue(ArrAuswahlNutzer, rng) Then
   If Not unionRng Is Nothing Then
       Set unionRng = Union(unionRng, rng)
   End If
       Set unionRng = rng  '<= use Union to gather range if all being pasted in a block somewhere
   End If
Next

If Not unionRng Is Nothing Then

    unionRng.EntireRow.Copy  'destination for paste

End If

Answer 3

很抱歉回答我自己的问题（当然欢迎对此解决方案进行更正/反馈）

我这样尝试过，我想它应该可以工作（不能真正测试，因为我的 makro 的其他部分没有工作） 这有点不必要的复杂，也许很慢，但我说它可以工作：

For i = 1 To VarAnzahlZeilen
    Set rng = Worksheets("Filter").Range(Cells(i, VarNutzerSpalte), Cells(i, VarNutzerSpalte))

    If IsInArrayValue(ArrAuswahlNutzer, rng) Then
        Worksheets("Import").Rows(j).Copy
        Worksheets("Filter").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    End If

Next i

QHarr 使用此函数（仅更改了数组名称）

Public Function IsInArrayValue(ByVal testArray As Variant, ByVal rng As Range) As Variant
    Dim i As Long, testString As String
    testString = rng.Text
    If rng.Cells.Count > 1 Then
        IsInArrayValue = CVErr(xlErrNA)
        Exit Function
    End If
    For i = LBound(testArray) To UBound(testArray)

        If InStr(testString, testArray(i)) > 0 Then
            IsInArrayValue = True
            Exit Function
        End If
    Next
    IsInArrayValue = False
End Function

非常感谢@QHarr 和@Dy.Lee！