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
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.