Excel 检查数组中是否存在值

我正在使用一个来自问题的函数，但是，在我的例子中它似乎不起作用

基本上，这个脚本通过一列选择不同的值并用它们填充数组

arr

。首先，如果

正在检查列是否已结束，然后为了避免调用空数组，我使用了第一个
如果else
，最后，我要检查非空数组中的
单元格
字符串。如果它不存在，我想添加它

Public Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
  IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function

Sub SelectDistinct()

    Dim arr() As String
    Dim i As Integer
    Dim cells As Range

    Set cells = Worksheets("types").Columns("A").Cells

    i = 0
    For Each cell In cells
        If IsEmpty(cell) Then
            Exit For
        ElseIf i = 0 Then
            ReDim Preserve arr(i)
            arr(UBound(arr)) = cell
            i = i + 1
        ElseIf IsInArray(cell.Value, arr) = False Then
            ReDim Preserve arr(i)
            arr(UBound(arr)) = cell
            i = i + 1
        End If
    Next cell
End Sub

出于某种原因，它在调用
IsInArray
函数时抛出“下标超出范围”错误。有人能告诉我哪里出错了吗？
下面是我如何使用
应用程序对一维数组执行此操作。Match
函数，而不是另一个UDF

我已经用
Do…While
循环整合了一些If/ElseIf逻辑，然后使用
Match
函数检查数组中是否存在单元格值。如果不存在，则将其添加到数组中，并继续到范围中的下一个单元格

Sub SelectDistinct()

Dim arr() As String
Dim i As Integer
Dim cells As Range
Dim cl As Range
Dim foundCl As Boolean

    Set cells = Worksheets("Sheet6").Columns(1).cells

    Set cl = cells.cells(1)

    Do
        If IsError(Application.Match(cl.Value, arr, False)) Then
            ReDim Preserve arr(i)
            arr(i) = cl
            i = i + 1
        Else:
            'Comment out the next line to completely ignore duplicates'
            MsgBox cl.Value & " already exists!"

        End If

        Set cl = cl.Offset(1, 0)
    Loop While Not IsEmpty(cl.Value)

End Sub

对调用
IsInArray
函数时出现的“下标超出范围”错误的简短回答是变量
arr
变暗为
Variant
。要使
Filter
函数在
IsInArray
UDF
arr
中工作，必须将
变暗为
字符串

您可以尝试以下代码：1）设置过滤的
字符串
数组，2）避免将
Redim Preserve
（这是一个代价高昂的函数）放入循环中：

Sub FilteredValuesInArray()
'http://stackoverflow.com/questions/16027095/checking-if-value-present-in-array
Dim rng As Range
Dim arrOriginal() As Variant, arrFilteredValues() As String
Dim arrTemp() As String
Dim strPrintMsg As String    'For debugging
Dim i As Long, lCounter As Long

Set rng = Cells(1, 1).CurrentRegion    'You can adjust this how you want
arrOriginal = rng

'Convert variant array to string array
ReDim arrTemp(LBound(arrOriginal) - 1 To UBound(arrOriginal) - 1)
For i = LBound(arrOriginal) To UBound(arrOriginal)
    arrTemp(i - 1) = CStr(arrOriginal(i, 1))
Next i

'Setup filtered values array
ReDim arrFilteredValues(LBound(arrTemp) To UBound(arrTemp))

On Error Resume Next
Do
    arrFilteredValues(lCounter) = arrTemp(0)
    'Save non matching values to temporary array
    arrTemp = Filter(arrTemp, arrTemp(0), False)
    'If error all unique values found; exit loop
    If Err.Number <> 0 Then Exit Do
    lCounter = lCounter + 1
Loop Until lCounter >= UBound(arrFilteredValues)
On Error GoTo 0
'Resize array to proper bounds
ReDim Preserve arrFilteredValues(LBound(arrFilteredValues) To lCounter - 1)

'====DEBUG CODE
For i = LBound(arrFilteredValues) To UBound(arrFilteredValues)
    strPrintMsg = strPrintMsg & arrFilteredValues(i) & vbCrLf
Next i
Debug.Print vbTab & "Filtered values are:" & vbCrLf & strPrintMsg
'====END DEBUG CODE
End Sub

Sub-FilteredValuesInArray（）
'http://stackoverflow.com/questions/16027095/checking-if-value-present-in-array
变暗rng As范围
Dim arrOriginal（）作为变量，arrFilteredValues（）作为字符串
Dim arrTemp（）作为字符串
用于调试的Dim STRPINTMSG作为字符串'
我越长，我越长
设置rng=单元格（1，1）。CurrentRegion'您可以根据需要进行调整
原始的
'将变量数组转换为字符串数组
ReDim ARRTTEMP（LBound（arrOriginal）-1至UBound（arrOriginal）-1
对于i=LBound（arrOriginal）到UBound（arrOriginal）
ARRTTEMP（i-1）=CStr（原始（i，1））
接下来我
'设置筛选值数组
ReDim arrFilteredValues（LBound（ARRTEM）到UBound（ARRTEM））
出错时继续下一步
做
arrFilteredValues（lCounter）=arrTemp（0）
'将不匹配的值保存到临时数组
arrTemp=过滤器（arrTemp，arrTemp（0），False）
'如果错误，则找到所有唯一值；退出循环
如果错误号为0，则退出Do
l计数器=l计数器+1
循环直到lCounter>=UBound（arrFilteredValues）
错误转到0
'将数组调整到适当的边界
ReDim保留arrFilteredValues（LBound（arrFilteredValues）到lCounter-1）
'==调试代码
对于i=LBound（arrFilteredValues）到UBound（arrFilteredValues）
strPrintMsg=strPrintMsg&arrFilteredValues（i）&vbCrLf
接下来我
Debug.Print vbTab&“筛选值为：”&vbCrLf&strPrintMsg
'==结束调试代码
端接头
这里有一个简单但肮脏的黑客：

Function InStringArray(str As String, a As Variant) As Boolean
    Dim flattened_a As String
    flattened_a = ""

    For Each s In a
        flattened_a = flattened_a & "-" & s
    Next

    If InStr(flattened_a, str) > 0 Then
        InStringArray = True
    Else
        InStringArray = False
    End If
End Function

如果您的数组只有一列，您可以使用
If-IsError（Application.Match（cell.Value，arr，False））
检查数组中是否已经存在该值。David，您是说一行吗？@sashkello是的，对不起。您好，我尝试使用此脚本。但是，在我的情况下，它似乎不起作用。是否有必要对arr（）进行一些初始化？非常感谢您的帮助！Best@FabianStolz请针对您遇到的问题提出一个新问题。请记住包含您正在使用的代码，并描述哪些代码有效/无效。