检查数组中是否存在值

我正在使用这个问题的function，但是，似乎并没有在我的情况下工作。

基本上，这个脚本正在经历一个列select不同的值和填充数组arr与他们。 首先If正在检查列是否已经结束，那么为了避免调用空数组我有第一个IfElse ，最后我想检查一个非空数组的cellstring。 如果不存在，我想添加它。

 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函数的调用中抛出“下标超出范围”错误。 有人可以让我知道我哪里错了吗？

Answer 1

这里是我如何做一维数组，使用Application.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 

Answer 2

对IsInArray函数调用的“下标超出范围”错误的IsInArray回答是，variablesarr变暗为Variant 。要在IsInArray UDF中工作的Filter函数， arr必须以Stringforms变暗。

您可以尝试以下代码：1）设置一个过滤的String数组; 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 

Answer 3

这里有一个简单而肮脏的黑客：

 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