revision codigo: sacar duplicado

[carnero]

Iniciado por pkj

Por muy bien que esten los códigos, (el mio solo tiene un ligero fallo), seguirás teniendo problemas mientras no cambies de sistema.

El fallo está en que un listbox solo admite 32767 elementos, y con solo que añadas 1 mas, los valores de listcount empiezan a ser negativos. De ese modo cuando intentas correr la sub, como el count es <0, no se hace nada y se sale de la sub. Por eso no te funciona con muchos elementos.


PD: De hecho lo he revisado y además de corregir el fallo que tenía lo he hecho muchisimo mas rápido:
PD2: Para solucionar el problema de la cantidad de elementos lo que puedes hacer es sumarlos segun cargas las listas y asi no habra fallos siempre que los codigos de articulo no superen los 32766 elementos.

Código vb:

Private Sub Command1_Click()
  CargarTabla
End Sub
 
Private Sub CargarTabla()
  Dim f As Long
  For f = 1 To 125767  ' MAXIMOS ELEMENTOS = NO HAY LIMITE
    List1.AddItem Int(Rnd * 15) + 1 ' MAXIMOS CODIGOS = 32766
    List2.AddItem Int(Rnd * 15) + 1
    List3.AddItem Int(Rnd * 15) + 1
    List4.AddItem Int(Rnd * 15) + 1
    List5.AddItem Int(Rnd * 15) + 1
    QuitaDup
  Next f
End Sub
 
Private Sub QuitaDup()
  Dim X As Long, I As Long, REINICIAR As Integer
  'MsgBox List1.ListCount
  REINICIAR = 1
  Do Until REINICIAR = 0
    REINICIAR = 0
    For I = 0 To List1.ListCount - 2
      For X = List1.ListCount - 1 To I + 1 Step -1
        If List1.List(I) = List1.List(X) Then ' SI TIENEN EL MISMO CODIGO SE SUMAN
          List2.List(I) = Val(List2.List(I)) + Val(List2.List(X))
          List3.List(I) = Val(List3.List(I)) + Val(List3.List(X))
          List4.List(I) = Val(List4.List(I)) + Val(List4.List(X))
          List5.List(I) = Val(List5.List(I)) + Val(List5.List(X))
          List1.RemoveItem X
          List2.RemoveItem X
          List5.RemoveItem X
          List3.RemoveItem X
          List4.RemoveItem X
          REINICIAR = 1
          'Exit For ' Y SE REINICIA EL TRABAJO PARA NO CONTAR CON LA LINEA ELIMINADA
        End If
      Next X
      DoEvents
      If REINICIAR = 1 Then Exit For
    Next I
  Loop
 
End Sub
 

Claro que, de este modo, la sub QuitaDup puede ser reemplazada por una que solo compare el ultimo elemento añadido a la lista, y sería mucho más rápido.

Código vb:

Private Sub Form_Load()
  CargarTabla
End Sub
 
Private Sub CargarTabla()
  Dim F As Long
  For F = 1 To 112767  ' MAXIMOS ELEMENTOS = NO HAY LIMITE ' 112767 ELEMENTOS CARGADOS Y SUMADOS EN 12 SEGUNDOS (EN MI PC)
    List1.AddItem Int(Rnd * 15) + 1 ' MAXIMOS CODIGOS = 32766
    List2.AddItem Int(Rnd * 15) + 1
    List3.AddItem Int(Rnd * 15) + 1
    List4.AddItem Int(Rnd * 15) + 1
    List5.AddItem Int(Rnd * 15) + 1
    QuitaDup
  Next F
End Sub
 
Private Sub QuitaDup()
  Dim I As Long, X As Long
  X = List1.ListCount - 1
  For I = 0 To List1.ListCount - 2
    If List1.List(I) = List1.List(X) Then
      List2.List(I) = Val(List2.List(I)) + Val(List2.List(X))
      List3.List(I) = Val(List3.List(I)) + Val(List3.List(X))
      List4.List(I) = Val(List4.List(I)) + Val(List4.List(X))
      List5.List(I) = Val(List5.List(I)) + Val(List5.List(X))
      List1.RemoveItem X
      List2.RemoveItem X
      List3.RemoveItem X
      List4.RemoveItem X
      List5.RemoveItem X
      Exit For
    End If
  Next I
End Sub
 

no tenia idea que tenia limite el list, la mejor solucion sera no usar el list

con que componente puedo hacer lo mismo y no tener estos problemas??
gracias otraves ;)