Function RemoveDuplicatedItemsFromArray(ByRef aArray() As String) As Long
'aArray tableau à dédoublonner, peut être vide ou non dimentionné, ne doit pas contrenir d'item CHR$(0)
'fonction retourne le nombre d'items
Dim asBuff() As String, lCount As Long, i As Long, j As Long, l As Long
If ((Not (Not aArray)) = 0) Then lCount = 0 Else lCount = UBound(aArray) - LBound(aArray) + 1
If lCount Then
If lCount = 1 Then
' rien à faire
RemoveDuplicatedItemsFromArray = 1
Else
' travaille en tampon
asBuff = aArray
l = LBound(asBuff)
For i = l To UBound(asBuff) - 1
For j = i + 1 To UBound(asBuff)
If (asBuff(i) = asBuff(j)) Then asBuff(j) = vbNullChar
Next j
Next i
' sauve
j = l - 1
For i = l To UBound(asBuff)
If Not (asBuff(i) = vbNullChar) Then
j = j + 1
aArray(j) = asBuff(i)
End If
Next i
' resize + retour
ReDim Preserve aArray(l To j)
RemoveDuplicatedItemsFromArray = UBound(aArray) - l + 1
End If
End If
Erase asBuff
End Function
'---------------------
'EXEMPLE D'UTILISATION
'---------------------
'
Private Sub Test()
Dim asResult() As String, i As Integer
ReDim asResult(1 To 20)
For i = 1 To 5
asResult(i) = "ligne " & i
asResult(i + 5) = "ligne " & i
asResult(i + 10) = "ligne " & i
asResult(i + 15) = "ligne " & i
Next i
Debug.Print RemoveDuplicatedItemsFromArray(asResult) & " lignes"
Debug.Print "========"
For i = LBound(asResult) To UBound(asResult)
Debug.Print asResult(i)
Next i
End Sub