revision codigo: sacar duplicado

[carnero]

HOLAS
CON LE SIGUIENTE CODIGO RECORRO LOS LISTBOX Y BUSCO DUPLICADOS Y SUMO CANTIDAD, PESO, VALOR.
EL ASUNTO ES QUE CON POCOS REGISTROS FUNCIONA, PERO CON MAS DE 100, NO.
PORFA SI ME PUEDEN AYUDAR

Código vb:

For i = 0 To (List1.ListCount) - 2
        P = i
        
For Ñ = 0 To (List1.ListCount) - 2
              If List1.List(i) <> List1.List(Ñ) And es = True Then   ' agrega datos y elimina p
                List1.ListIndex = P
                List2.ListIndex = P
                List5.ListIndex = P
                List3.ListIndex = P
                List4.ListIndex = P
                                                                                                              
                cod = List1.Text
                uni = uni + Round(List5.Text)
                peso = peso + Round(List3.Text)
                neto = neto + Round(List4.Text)
                des = List2.Text
                                                                                                              
                List1.RemoveItem P
                List2.RemoveItem P
                List5.RemoveItem P
                List3.RemoveItem P
                List4.RemoveItem P
                                                                                                              
                List1.AddItem cod
                List2.AddItem des
                List3.AddItem peso
                List4.AddItem neto
                List5.AddItem uni
                es = False
        End If
    If List1.List(i) = List1.List(Ñ) Then
            List1.ListIndex = Ñ
        If List1.ListIndex = i Then GoTo sig
                List2.ListIndex = Ñ
                List3.ListIndex = Ñ
                List5.ListIndex = Ñ
                List4.ListIndex = Ñ
                uni = uni + Int(List5.Text)
                peso = peso + Round(List3.Text)
                neto = neto + Round(List4.Text)
                List1.RemoveItem Ñ
                List2.RemoveItem Ñ
                List3.RemoveItem Ñ
                List5.RemoveItem Ñ
                List4.RemoveItem Ñ
                    es = True
    End If
    
sig:
Next Ñ
Next i
 

muuuuuuuuuuuuuuuuuuchas graciassss!!!

[carnero]

alguien me puede dar siquiera alguna idea?
porfavor

[erbuson]

Hola, el problema creo, por lo menos por mi parte, es que me cuesta mucho intentar adivinar lo que estas haciendo ya que, aunque para gustos colores, no termino de entender porque utilizas la información tan desperdigada en List, cuando podrías tenerla en un MsFlexGrid, que una vez puesta podrías ordenar por la columna de código y después ir recalculando los totales.

¿ Se supone que cada List tiene 1 dato relacionado con los demàs ?

[pkj]

Concuerdo con Erbuson en que no se tiene muy claro que intentas hacer en ese código.
Según tu texto (y en contra de lo que parece querer tu codigo) se me hace que intentas algo como esto:

Código vb:

Dim X As Long, I As Long, REINICIAR As Integer
 
  REINICIAR = 1
  Do Until REINICIAR = 0
    REINICIAR = 0
    For I = 1 To List1.ListCount - 2
      For X = I + 1 To List1.ListCount - 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
          List3.RemoveItem X
          List4.RemoveItem X
          List5.RemoveItem X
          REINICIAR = 1
          Exit For 
        End If
      Next X
      If REINICIAR = 1 Then Exit For
    Next I
  Loop
 

El como se sumen ya tu lo verás. Eso del Round y tal...

Saludos

[carnero]

Iniciado por erbuson

Hola, el problema creo, por lo menos por mi parte, es que me cuesta mucho intentar adivinar lo que estas haciendo ya que, aunque para gustos colores, no termino de entender porque utilizas la información tan desperdigada en List, cuando podrías tenerla en un MsFlexGrid, que una vez puesta podrías ordenar por la columna de código y después ir recalculando los totales.

¿ Se supone que cada List tiene 1 dato relacionado con los demàs ?

PORQUE NO SE USAR EL MSFLEXGRID

LIST1.LISTINDEX= 1 SE RELACIONA CON LIST1.LISTINDEX= 2 Y CON LIST1.LISTINDEX= ...

Y ESTOS SE PUEDEN REPETIR EN EL LIST, ENTONCES LOS TENGO QUE JUNTAR Y RECALCULAR.

OAJALA ME ENTIENDAN
MUCHAS GRACIAS POR EL TIEMPO!

[erbuson]

Una vez que le coges el tranquillo, es bastante simple, al fin y al cabo es como si se tratara de una Hoja Excel, a base de Filas y Columnas y probablemente es mas facil de entender si piensas que las filas son los Registros de un archivo y las columnas los campos.

Si quieres, indica cual es la extructura de tu fichero y que tipo de datos y en un par de 'lecciones' te digo como usarlo de un modo eficiente.

Ten en cuenta que tiene funciones de ordenacion automática y puedes hacer algunas funciones de tipo generíco para usarlas con el Grid y simplificar mucho su proceso.

En cuanto a tu comentario dices que List1.ListIndex = 1 se relaciona con List1.ListIndex = 2, inicialmente había supuesto que List1.ListIndex =1 se correspondia con List2.ListIndex = 1 (mira tu si lo había entendido mal)

Si es como has dicho, creo que en realidad la extructura la tienes mal planteada, pues lo lógico sería por ejemplo:

List1.ListIndex=1 ... Referencia
List2.ListIndex=1 ... Unidades
List3.ListIndex=1 ... Precio
List4.ListIndex=1 ... Importe

List1.ListIndex=2 ... Referencia
List2.ListIndex=2 ... Unidades
List3.ListIndex=2 ... Precio
List4.ListIndex=2 ... Importe

¿ No crees ?

[carnero]

Iniciado por erbuson

Una vez que le coges el tranquillo, es bastante simple, al fin y al cabo es como si se tratara de una Hoja Excel, a base de Filas y Columnas y probablemente es mas facil de entender si piensas que las filas son los Registros de un archivo y las columnas los campos.

Si quieres, indica cual es la extructura de tu fichero y que tipo de datos y en un par de 'lecciones' te digo como usarlo de un modo eficiente.

Ten en cuenta que tiene funciones de ordenacion automática y puedes hacer algunas funciones de tipo generíco para usarlas con el Grid y simplificar mucho su proceso.

En cuanto a tu comentario dices que List1.ListIndex = 1 se relaciona con List1.ListIndex = 2, inicialmente había supuesto que List1.ListIndex =1 se correspondia con List2.ListIndex = 1 (mira tu si lo había entendido mal)

Si es como has dicho, creo que en realidad la extructura la tienes mal planteada, pues lo lógico sería por ejemplo:

List1.ListIndex=1 ... Referencia
List2.ListIndex=1 ... Unidades
List3.ListIndex=1 ... Precio
List4.ListIndex=1 ... Importe

List1.ListIndex=2 ... Referencia
List2.ListIndex=2 ... Unidades
List3.ListIndex=2 ... Precio
List4.ListIndex=2 ... Importe

¿ No crees ?

nonono me exprese mal, es:

List1.ListIndex=1 ... Referencia

List2.ListIndex=1 ... Unidades

List3.ListIndex=1 ... Precio

List4.ListIndex=1 ... Importe

te agradeceria que me ayudes con el MSFLEXGRID.
por ejemplo como le cargo una consulta sql o si por ejemplo puedo comparar 2 consultas, osea, que me entregue todos los registros de la consulta A que no estan en la consulta B.

gracias

[carnero]

Iniciado por pkj

Concuerdo con Erbuson en que no se tiene muy claro que intentas hacer en ese código.
Según tu texto (y en contra de lo que parece querer tu codigo) se me hace que intentas algo como esto:

Código vb:

Dim X As Long, I As Long, REINICIAR As Integer
 
  REINICIAR = 1
  Do Until REINICIAR = 0
    REINICIAR = 0
    For I = 1 To List1.ListCount - 2
      For X = I + 1 To List1.ListCount - 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
          List3.RemoveItem X
          List4.RemoveItem X
          List5.RemoveItem X
          REINICIAR = 1
          Exit For 
        End If
      Next X
      If REINICIAR = 1 Then Exit For
    Next I
  Loop
 

El como se sumen ya tu lo verás. Eso del Round y tal...

Saludos

y si hay mas registros iguales' porejemplo en un list con 100000 registros 6255 son iguales? gracias

mira mi codigo:

Código vb:

For I = 0 To List1.ListCount - 2
   if I >= List1.ListCount Then Exit For    le tuve que poner esa condicion porque sino al quitar los campos repetidos el for sigue de largo y me tira error, aunque en teoria no deveria si el for esta en 9 y listcount en 9 o 10 deberia salirse!! 
                List1.ListIndex = I
            P = List1.ListIndex
            
      For X = 0 To List1.ListCount - 2
      'If X >= List1.ListCount Then Exit For
            If eli = True Then
            X = X - 1
            eli = False
            End If
            
            List1.ListIndex = X
                     If List1.ListIndex = P Then GoTo sig
        If List1.List(I) = List1.List(X) Then ' SI TIENEN EL MISMO CODIGO SE SUMAN
 
                                                                                                        
                        uni = uni + Int(Val(List5.List(X)))
                        peso = Round(peso, 2) + Round(Val(List3.List(X)), 2)
                        neto = neto + Round(Val(List4.List(X)))
                                                                                                        
          List1.RemoveItem X
          List2.RemoveItem X
          List3.RemoveItem X
          List4.RemoveItem X
          List5.RemoveItem X
          
          eli = True
          REINICIAR = 1
            est = True
          'Exit For
          
        End If
sig:
      Next X
     ' If REINICIAR = 1 Then Exit For
    Next I
  Loop
 

que opinas? como lo podria mejorar?

gracias ;)

edito----
no funciona con muchos registros u.u

[erbuson]

Iniciado por carnero

te agradeceria que me ayudes con el MSFLEXGRID.
por ejemplo como le cargo una consulta sql o si por ejemplo puedo comparar 2 consultas, osea, que me entregue todos los registros de la consulta A que no estan en la consulta B.

gracias

Aqui si que lo lamento, pero en cuanto a Bases de Datos, ni pajolera idea, cuando yo empecé con esto hace muuuuchos años, casi ni existían y mis programas se basan en archivos directos y la carga de estos hacia el Grid, nada tiene que ver con técnicas SQL

Ya digo, el Grid es mi pasión pero las Bases de Datos, van a ser esa asignatura que me va a quedar siempre pendiente, a estas alturas no estoy para cambiar de sistema, ten en cuenta que soy casi tan prehistórico como el Ms-Dos

Un saludo

[carnero]

Iniciado por erbuson

Aqui si que lo lamento, pero en cuanto a Bases de Datos, ni pajolera idea, cuando yo empecé con esto hace muuuuchos años, casi ni existían y mis programas se basan en archivos directos y la carga de estos hacia el Grid, nada tiene que ver con técnicas SQL

Ya digo, el Grid es mi pasión pero las Bases de Datos, van a ser esa asignatura que me va a quedar siempre pendiente, a estas alturas no estoy para cambiar de sistema, ten en cuenta que soy casi tan prehistórico como el Ms-Dos

Un saludo

ajajaajajajajjaajajjajaja

bueno pero cargar datos lo veo por otro lado, como que opciones tienes con el MsFlexGrid.
por ejemplo la misma pregunta pero olvidate de las bd.
como comparo 2 MsFlexGrid?

[erbuson]

Mientras tu contestabas, yo estaba dandole vueltas a esta opcion, que no la he probado pero se me ocurre que podría funcionar.

Código vb:

Private Sub Totalizacion()
  Dim Hasta As Integer, LineaActual As Integer, LineaTotales As Integer
  Hasta = List1.ListCount - 1
  ' Efectuamos un bucle invertido desde el final
  For LineaActual = Hasta To 0 Step -1
    ' Conservaremos en el 1º los totales de las referencias iguales
    LineaTotales = ElPrimero(List1.List(LineaActual))
    ' Si la linea de Totales es distinta de la linea actual,
    ' significa que como mínimo hay dos
    If LineaTotales <> LineaActual Then
      ' Sumamos la actual a la inicial
      List2.List(LineaTotales) = List2.List(LineaTotales) + List2.List(LineaActual)
      List3.List(LineaTotales) = List3.List(LineaTotales) + List3.List(LineaActual)
      List4.List(LineaTotales) = List4.List(LineaTotales) + List4.List(LineaActual)
      List5.List(LineaTotales) = List5.List(LineaTotales) + List5.List(LineaActual)
      ' Eliminamos la linea procesada de todos los List
      List1.RemoveItem (LineaActual)
      List2.RemoveItem (LineaActual)
      List3.RemoveItem (LineaActual)
      List4.RemoveItem (LineaActual)
      List5.RemoveItem (LineaActual)
    End If
  Next
End Sub
 
Private Function ElPrimero(Referencia As String) As Integer
  ' Devuelve el número de indice del 1er elemento coincidente
  For ElPrimero = 0 To List1.ListCount - 1
    If List1.List(ElPrimero) = Referencia Then Exit Function
  Next
End Function
 

La idea es mantener como linea de Total la primera aparicion de la referencia en el list, acumulando hacia esta desde el final hacia arriba.

Si quieres pruebalo y me dices si algo funciona o falla.

[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
 

[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 ;)