Содержит ли ячейка значение из массива

Question

еще раз проблема, которую я не могу найти совершенно правильный ответ через поиск, даже если кажется, что я близок.Моя цель - проверить в одном столбце, содержит ли каждая ячейка (помимо других значений) письмо из моего массива.

Таким образом, ячейки выглядят примерно как 123A.Мой массив содержит значения A, C, D, X, Y, Z.Оба просто примерные значения.No my If statment должен иметь значение true, если ячейка содержит какие-либо буквы, поэтому для примера это должно быть значение trueДля значения ячейки 123B это должно быть неверно (в массиве нет 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 для циклического перемещения по столбцу (я бы сказал, ^^)

Большое спасибо заранее, Iam также открыт для "креативных" решений, если у вас есть какие-то новые идеи, как сделать это лучше.

Answer 1

Вы можете изменить его на

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, вы можете либо передать массив, как показано выше, либо, если массив не изменяется, вы можете перейти в саму функцию.Лично я предпочитаю передавать массив в качестве аргумента функции как более гибкий.Я не могу понять, откуда исходит ваша строка для копирования.Ваш комментарий, публикуемый как ответ, использует переменную aj, которая, как представляется, не участвует в показанном цикле, а строка копируется с другого листа.Поэтому ниже не будет работать напрямую, но дает вам рамки.

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 2

Извините, что отвечаю на мой собственный вопрос (исправления / отзывы к этому решению, конечно, приветствуются)

Я попробовал это так, и я думаю, что это должно работать (не могу проверить, потому что другие части моего макро не работают) Это немного ненужно сложно и, возможно, медленно, но id говорит, что это может сработать:

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!

Answer 3

Попробуйте,

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