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:
Ver originalPrivate 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:
Ver originalPrivate 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