# 检查数组中是否存在值checking if value present in array

``````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
``````

## 3 个回复3

### ===============>>#1 票数：4 已采纳

``````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 票数：1

``````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
``````

### ===============>>#3 票数：0

``````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
``````

7回复

1回复

6回复

1回复

1回复

2回复

6回复

1回复

1回复

1回复