checking if value present in array

后端 未结 3 1922
醉话见心
醉话见心 2021-01-13 19:28

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 an

3条回答
  •  温柔的废话
    2021-01-13 20:11

    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.

    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:

    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
    

提交回复
热议问题