eliminar duplicados en una listbox

[David_erh]

Hola a todos l@s chi@s del foro, tengo una rutina en Visual basic con la cual en un form agrego nombres a una listbox teniendo como origen un archivo de excel. Pero aveces algunos nombres estan repetidos; así que buscaba una rutina q elimine los duplicados del listbox y conseguí la siguiente:

Public Sub Duplicados(listbox As listbox)
Dim Search1 As Long
Dim Search2 As Long
Dim KillDupe As Long
KillDupe = 0
For Search1& = 0 To listbox.ListCount - 1
For Search2& = Search1& + 1 To listbox.ListCount - 1
KillDupe = KillDupe + 1
If listbox.List(Search1&) = listbox.List(Search2&) Then
listbox.RemoveItem Search2&
Search2& = Search2& - 1
End If
Next Search2&
Next Search1&
End Sub


El problema es q funciona siempre y cuando el número de items en la listbox sea pequeño (4 o 5)pero si es de 10 o mas la rutina no funciona y hasta ahora no encuentro el porque; espero me ayuden.
Gracias.

David

[luciano]

Hola te paso un ejemplo:

Código:

Dim Arreglo() As String
Dim TempArray() As String

Private Sub Command1_Click()

    Dim x As Integer, x2 As Integer, y As Integer
    Dim z As Integer, Elemento As Variant
    List1.Clear
   

        ReDim Arreglo(6)
        Arreglo(0) = "1"
        Arreglo(1) = "2"
        Arreglo(2) = "3"
        Arreglo(3) = "3"
        Arreglo(4) = "3"
        Arreglo(5) = "2"
        Arreglo(6) = "1"
        For i = LBound(Arreglo) To UBound(Arreglo)
          
          ReDim Preserve TempArray(i)
          
          TempArray(i) = Arreglo(i)
        
        Next
    
    For x = 0 To UBound(Arreglo)
        z = 0

        For y = 0 To UBound(Arreglo)
            
            If Arreglo(x) = TempArray(z) And y <> x Then
                
                Arreglo(y) = ""
                Nduplicado = Nduplicado + 1
            End If
            z = z + 1
        Next y
    Next x
    For Each Elemento In Arreglo
        
        If Elemento <> "" Then List1.AddItem Elemento
    Next
    MsgBox "Elementos duplicados: " & Nduplicado, vbInformation
    
End Sub

------------------

[carnero]

Iniciado por luciano

Hola te paso un ejemplo:

Código:

Dim Arreglo() As String
Dim TempArray() As String

Private Sub Command1_Click()

    Dim x As Integer, x2 As Integer, y As Integer
    Dim z As Integer, Elemento As Variant
    List1.Clear
   

        ReDim Arreglo(6)
        Arreglo(0) = "1"
        Arreglo(1) = "2"
        Arreglo(2) = "3"
        Arreglo(3) = "3"
        Arreglo(4) = "3"
        Arreglo(5) = "2"
        Arreglo(6) = "1"
        For i = LBound(Arreglo) To UBound(Arreglo)
          
          ReDim Preserve TempArray(i)
          
          TempArray(i) = Arreglo(i)
        
        Next
    
    For x = 0 To UBound(Arreglo)
        z = 0

        For y = 0 To UBound(Arreglo)
            
            If Arreglo(x) = TempArray(z) And y <> x Then
                
                Arreglo(y) = ""
                Nduplicado = Nduplicado + 1
            End If
            z = z + 1
        Next y
    Next x
    For Each Elemento In Arreglo
        
        If Elemento <> "" Then List1.AddItem Elemento
    Next
    MsgBox "Elementos duplicados: " & Nduplicado, vbInformation
    
End Sub

------------------

aunque tarde pero me ubiese servido un poco de explicacion xD 3:00 AM ajajaja