检查数组中是否存在值

I'm using a function from this question, however, it doesn't seem to work in my case.

我用的是这个问题中的一个函数，但是，它在我的例子中似乎不成立。

Basically, this script is going through a column selecting distinct values and populating array arr with them. First If is checking if the column has ended, then to avoid calling empty array I have the first IfElse, and finally I want to check a non-empty array for cell string. If it is not present, I want to add it.

基本上，这个脚本通过一个列来选择不同的值并使用它们填充数组arr。首先如果是检查列是否已结束，然后为了避免调用第一个IfElse的空数组，最后要检查单元格字符串的非空数组。如果它不存在，我想添加它。

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

For some reason, it throws "Subscript out of range" error on the call of IsInArray function. Can someone let me know where I went wrong?

由于某些原因，它将“下标超出范围”的错误，在调用了“数组”函数时出错。有人能告诉我哪里出错了吗?

3 个解决方案

#1

Here is how I would do it for a one-dimensional array, using the Application.Match function, instead of another UDF.

下面是我使用应用程序对一维数组做的操作。匹配功能，而不是另一个UDF。

I have consolidated some of your If/ElseIf logic with a Do...While loop, and then use the Match function to check whether cell value exists in the array. If it does not exist, then add it to the array and continue to the next cell in your range.

我把你的一些If/ElseIf逻辑和一个Do合并了……然后使用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

#2

Short answer to your "Subscript out of range" error on the call of IsInArray function" question is that the variable arr is dimmed as Variant. For the Filter function to work in the IsInArray UDF arr must be dimmed as a String.

对于“超出范围的下标”调用伊辛斯基罗函数错误的简短回答是，变量arr被变暗为变异体。要让过滤器函数在伊辛基罗UDF中工作，必须将arr调暗为字符串。

You can try the following code which 1) Sets up a filtered String array, and 2) avoids placing Redim Preserve (which is a costly function) in a loop:

您可以尝试以下代码，其中1)设置一个过滤后的字符串数组，2)避免将Redim保存(这是一个开销很大的函数)在一个循环中:

Sub FilteredValuesInArray()
'http://*.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

#3

Here's an easy yet dirty hack :

这里有一个简单而又肮脏的方法:

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

#1