Mostrar valores únicos y sumados listbox
¿Hola Dan Como esta?
Recurro a ud nuevamente.. Si es que me hecha una mano por favor ..
Lo que pasa que tengo una base de datos con las siguientes columnas partiendo desde la columna A
Patente -chofer- fecha- kilometraje -descripción
Tengo un listbox que lo filtro con un textbox y me aparecen los datos "solo patente y kilometraje". Pero lo que me gustaría que me ayudases. En que los datos fueran únicos " patentes y que ya se mostrasen sumados los kilómetros ..
1 respuesta
Adapta lo siguiente a tu userform, es un ejemplo, debes adaptarlo a tus datos
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
If textbox1 = textbox1 Then 'aquí va tu condición de filtro
existe = False
For j = 0 To ListBox1.ListCount - 1
If Cells(i, "A").Text = ListBox1.List(j) Then
ListBox1.List(j, 1) = ListBox1.List(j, 1) + Cells(i, "D")
existe = True
Exit For
End If
Next
If existe = False Then
ListBox1.AddItem Cells(i, "A").Value
ListBox1.List(ListBox1.ListCount - 1, 1) = Cells(i, "D").Value
End If
End If
Next'.[Sal u dos. Dante Amor. No olvides valorar la respuesta. '.[Avísame cualquier duda
Gracias Dan..
Suma bien!! pero si busco otra patente vuelve a sumar lo ya sumado ej: patente 1 la tengo dos veces y cada una tiene 3 kilómetros y la otra tiene 2 kilómetros lo que suma 5 = patente 1 kilometraje = 5
si busco la patente 2 la suma de la patente 1 ahora es 10.. va sumando lo ya sumado otra vez.
Por favor Dan
Saludos
Supongo que le hiciste cambios a lo que te envié, podrías poner cómo dejaste el código.
Private Sub txtbuscar_Change()
For I = 2 To Hoja1.Range("A" & Rows.Count).End(xlUp).Row
cadena = UCase(Hoja1.Cells(I, 1))
If cadena Like "*" & UCase(txtbuscar) & "*" And Hoja1.Cells(I, "A") <> 0 Then
existe = False
ListBox1 = ""
For j = 0 To ListBox1.ListCount - 1
If Cells(I, "A").Text = ListBox1.List(j) Then
ListBox1.List(j, 1) = ListBox1.List(j, 1) + Cells(I, "D")
existe = True
Exit For
End If
Next
If existe = False Then
ListBox1.AddItem Cells(I, "A").Value
ListBox1.List(ListBox1.ListCount - 1, 1) = Cells(I, "D").Value
End If
End If
Next
End SubSi le puse unas líneas al principio..
Falta que limpies el listbox, prueba así:
Private Sub txtbuscar_Change()
listbox1.clear
For I = 2 To Hoja1.Range("A" & Rows.Count).End(xlUp).Row
cadena = UCase(Hoja1.Cells(I, 1))
If cadena Like "*" & UCase(txtbuscar) & "*" And Hoja1.Cells(I, "A") <> 0 Then
existe = False
'
For j = 0 To ListBox1.ListCount - 1
If hoja1.Cells(I, "A").Text = ListBox1.List(j) Then
ListBox1.List(j, 1) = ListBox1.List(j, 1) + hoja1.Cells(I, "D")
existe = True
Exit For
End If
Next
If existe = False Then
ListBox1.AddItem hoja1.Cells(I, "A").Value
ListBox1.List(ListBox1.ListCount - 1, 1) = hoja1.Cells(I, "D").Value
End If
End If
Next
End Sub
