Sumar columna de listbox a un texbox cuando ingreso datos
Eh visto varias preguntas similares y respuestas a lo que quiero hacer. Pero no me resulta la suma, solo me muestra el valor que voy ingresando en su momento.
En mi formulario vba de excel realizo una búsqueda de datos en combobox, resultado búsqueda se muestra en mis textbox, agrego un dato a otro textbox y esos datos los traspaso a mi listbox con un botón AGREGAR.
Este es mi código;
Private Sub Agregar_Click()
If ListBox1.ListCount = 20 Then
MsgBox "Se llegó al maximo de 20 Elementos"
Else
ListBox1.AddItem
a = ListBox1.ListCount - 1
ListBox1.List(a, 0) = Txt_Codigo.Value
ListBox1.List(a, 1) = Cbo_Producto.Value
ListBox1.List(a, 2) = Txt_Stock.Value
ListBox1.List(a, 3) = Txt_Und.Value
ListBox1.List(a, 4) = Txt_Cant.Value
ListBox1.List(a, 5) = Txt_Neto.Value
End If
Total = 0
For i = 0 To ListBox1.ListCount - 1
Total = Total + Val(ListBox1.List(i, 4))
Next i
Txt_TotalNeto.Text = Total
Cbo_Producto.Clear
Txt_Cant = ""
End Sub
Agradecería su ayuda para poder sumar todos mis item que ingreso a mi listbox
1 Respuesta
[Hola Prueba así:
Private Sub CommandButton1_Click() If ListBox1.ListCount = 20 Then MsgBox "Se llegó al maximo de 20 Elementos" Else ListBox1.AddItem a = ListBox1.ListCount - 1 ListBox1.List(a, 0) = Txt_Codigo.Value ListBox1.List(a, 1) = Cbo_Producto.Value ListBox1.List(a, 2) = Txt_Stock.Value ListBox1.List(a, 3) = Txt_Und.Value ListBox1.List(a, 4) = Txt_Cant.Value ListBox1.List(a, 5) = Txt_Neto.Value End If Total = 0 For i = 0 To ListBox1.ListCount - 1 Total = Total + Format(ListBox1.List(i, 4)) ListBox1.List(i, 4) = Format(ListBox1.List(i, 4), "#,##0.00") & " €" Next i Txt_TotalNeto.Value = Total Cbo_Producto.Clear Txt_Cant = "" End Sub
Si no te funciona con la anterior, prueba de esta manera:
Private Sub CommandButton1_Click() If ListBox1.ListCount = 20 Then MsgBox "Se llegó al maximo de 20 Elementos" Else ListBox1.AddItem a = ListBox1.ListCount - 1 ListBox1.List(a, 0) = Txt_Codigo.Value ListBox1.List(a, 1) = Cbo_Producto.Value ListBox1.List(a, 2) = Txt_Stock.Value ListBox1.List(a, 3) = Txt_Und.Value ListBox1.List(a, 4) = Txt_Cant.Value ListBox1.List(a, 5) = Txt_Neto.Value a = a + 1 SumaTotal End If Cbo_Producto.Clear Txt_Cant = "" End Sub Public Sub SumaTotal() Total = 0 For i = 0 To ListBox1.ListCount - 1 Total = Total + Format(ListBox1.List(i, 4)) ListBox1.List(i, 4) = Format(ListBox1.List(i, 4), "#,##0.00") & " €" Next i Txt_TotalNeto.Value = Total End Sub
Recuerda valorar la respuesta y cerrar la consulta
Hola Carlos Arrocha... gracias por tu respuesta... probé ambas fórmulas pero no realiza la suma, solo muestra el ultimo resultado ingresado.

Declara variables en encabezado
Dim a As long Dim Total As Double
'He cambiado la variable i por la a 'by Carlos Arrocha Public Sub SumaTotal() Total = 0 For a = 0 To ListBox1.ListCount - 1 Total = Total + Format(ListBox1.List(a, 4)) ListBox1.List(a, 4) = Format(ListBox1.List(a, 4), "#,##0.00") & " €" Next a Txt_TotalNeto.Value = Total End Sub
Estimado Carlos... al parecer algo estoy haciendo mal... no me resulta la suma, solo se agrega el ultimo valor de la fila que ingreso. Ajunto codigo;
Private Sub Agregar_Click()
Dim a As Long
Dim Total As Double
If ListBox1.ListCount = 20 Then
MsgBox "Se llegó al maximo de 20 Elementos"
Else
ListBox1.AddItem
a = ListBox1.ListCount - 1
ListBox1.List(a, 0) = Txt_Codigo.Value
ListBox1.List(a, 1) = Cbo_Producto.Value
ListBox1.List(a, 2) = Txt_Stock.Value
ListBox1.List(a, 3) = Txt_Und.Value
ListBox1.List(a, 4) = Txt_Cant.Value
ListBox1.List(a, 5) = Txt_Neto.Value
a = a + 1
SumaTotal
End If
Cbo_Departamento = ""
Cbo_Producto.Clear
Txt_Cant = ""
End Sub
Public Sub SumaTotal()
Total = 0
For a = 0 To ListBox1.ListCount - 1
Total = Total + Format(ListBox1.List(a, 4))
ListBox1.List(a, 4) = Format(ListBox1.List(a, 4), "#,##0")
Next a
Txt_TotalNeto.Value = Total
End Sub
Muchas gracias...
He probado esta macro en un formulario que he preparado con los datos suyos y me funciona bien.
Dim a As Long Dim Total As Double Private Sub Agregar_Click() If ListBox1.ListCount = 20 Then MsgBox "Se llegó al maximo de 20 Elementos" Else ListBox1.AddItem a = ListBox1.ListCount - 1 ListBox1.List(a, 0) = Txt_Codigo.Value ListBox1.List(a, 1) = Cbo_Producto.Text ListBox1.List(a, 2) = Txt_Stock.Text ListBox1.List(a, 3) = Txt_Und.Text ListBox1.List(a, 4) = Txt_Cant.Text ListBox1.List(a, 5) = Txt_Neto.Text a = a + 1 SumaTotal End If 'Cbo_Departamento = "" Cbo_Producto = Empty Txt_Cant = "" Txt_Neto = "" Txt_Und = "" Txt_Stock = "" Txt_Codigo = "" End Sub Public Sub SumaTotal() Total = 0 For a = 0 To ListBox1.ListCount - 1 Total = Total + Val(ListBox1.List(a, 4)) ListBox1.List(a, 4) = Format(ListBox1.List(a, 4), "#,##0") Txt_TotalNeto.Value = Total Next a End Sub
Estimado Carlos... creo que algo tengo mal... volví a copiar tu código y no realiza la suma. No se si sera algún código dentro de mi formulario que me este afectando (lo adjunto)
Dim a As Long
Dim Total As Double
-------------------------------------------------------
Private Sub Agregar_Click()
If ListBox1.ListCount = 20 Then
MsgBox "Se llegó al maximo de 20 Elementos"
Else
ListBox1.AddItem
a = ListBox1.ListCount - 1
ListBox1.List(a, 0) = Txt_Codigo.Value
ListBox1.List(a, 1) = Cbo_Producto.Text
ListBox1.List(a, 2) = Txt_Stock.Text
ListBox1.List(a, 3) = Txt_Und.Text
ListBox1.List(a, 4) = Txt_Cant.Text
ListBox1.List(a, 5) = Txt_Neto.Text
a = a + 1
SumaTotal
End If
Cbo_Departamento = ""
Cbo_Producto = Empty
Txt_Cant = ""
Txt_Neto = ""
Txt_Und = ""
Txt_Stock = ""
Txt_Codigo = ""
End Sub
Public Sub SumaTotal()
Total = 0
For a = 0 To ListBox1.ListCount - 1
Total = Total + CDbl(ListBox1.List(a, 4))
ListBox1.List(a, 4) = Format(ListBox1.List(a, 4), "#,##0")
Txt_TotalNeto.Text = Total
Next a
End Sub
-------------------------------------------------------------------
Private Sub Cbo_Departamento_Change()
Dim fila As Integer
Dim uf As Integer
Dim d1, d2 As String
Dim final As Integer
fila = 2
uf = Sheets("ListadoInventario").Range("H" & Rows.Count).End(xlUp).Row
Cbo_Producto.Clear
While Sheets("ListadoInventario").Cells(fila, 8) <> Empty
d1 = Cbo_Departamento
d2 = Sheets("ListadoInventario").Cells(fila, 8)
If d1 = d2 Then
Cbo_Producto.AddItem Sheets("ListadoInventario").Cells(fila, 2)
End If
fila = fila + 1
Wend
End Sub
-------------------------------------------------------------
Private Sub Cbo_Producto_Change()
Dim fila As Integer
Dim final As Integer
If Cbo_Producto.Value = "" Then
Me.Txt_Codigo = ""
Me.Txt_Stock = ""
Me.Txt_Und = ""
Me.Txt_Cant = ""
Me.Txt_Neto = ""
End If
For fila = 2 To 30000
If Hoja5.Cells(fila, 2) = "" Then
final = fila - 1
Exit For
End If
Next
For fila = 2 To final
If Cbo_Producto = Hoja5.Cells(fila, 2) Then
Me.Txt_Codigo = Hoja5.Cells(fila, 1)
Me.Txt_Stock = Hoja5.Cells(fila, 6)
Me.Txt_Und = Hoja5.Cells(fila, 4)
Exit For
End If
Next
End Sub
--------------------------------------------------------------
Private Sub Cbo_RutCliente_Change()
Dim fila As Integer
Dim final As Integer
If Cbo_RutCliente.Value = "" Then
Me.Txt_Cliente = ""
Me.Txt_Contacto = ""
Me.Txt_Mail = ""
Me.Txt_Fono = ""
End If
For fila = 2 To 30000
If Hoja7.Cells(fila, 1) = "" Then
final = fila - 1
Exit For
End If
Next
For fila = 2 To final
If Cbo_RutCliente = Hoja7.Cells(fila, 1) Then
Me.Txt_Cliente = Hoja7.Cells(fila, 2)
Me.Txt_Contacto = Hoja7.Cells(fila, 7)
Me.Txt_Mail = Hoja7.Cells(fila, 9)
Me.Txt_Fono = Hoja7.Cells(fila, 8)
Exit For
End If
Next
End Sub
--------------------------------------------------------------
Private Sub Cbo_RutCliente_Enter()
Dim fila As Integer
Dim final As Integer
Dim Lista As String
For fila = 2 To Cbo_RutCliente.ListCount
Cbo_RutCliente.RemoveItem 0
Next fila
For fila = 3 To 30000
If Hoja7.Cells(fila, 1) = "" Then
final = fila - 1
Exit For
End If
Next
For fila = 2 To final
Lista = Hoja7.Cells(fila, 1)
Cbo_RutCliente.AddItem (Lista)
Next
End Sub
----------------------------------------------------
Private Sub CommandButton1_Click()
Unload Me
End Sub
-----------------------------------------------------
Private Sub CommandButton2_Click()
´este comando me permite guardar dato modificado
ListBox1.AddItem
a = ListBox1.ListCount - 1
ListBox1.List(a, 0) = Txt_Codigo.Value
ListBox1.List(a, 1) = Cbo_Producto.Value
ListBox1.List(a, 2) = Txt_Stock.Value
ListBox1.List(a, 3) = Txt_Und.Value
ListBox1.List(a, 4) = Txt_Cant.Value
ListBox1.List(a, 5) = Txt_Neto.Value
Txt_Codigo = ""
Cbo_Producto = ""
Txt_Stock = ""
Txt_Und = ""
Txt_Cant = ""
Txt_Neto = ""
End Sub
--------------------------------------------------------------------------
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
´Selecciono dato en el listbox y lo transfiero a los textbox para modificar información
Txt_Codigo = ListBox1.Column(0)
Cbo_Producto = ListBox1.Column(1)
Txt_Stock = ListBox1.Column(2)
Txt_Und = ListBox1.Column(3)
Txt_Cant = ListBox1.Column(4)
Txt_Neto = ListBox1.Column(5)
ListBox1.RemoveItem ListBox1.ListIndex
End Sub
-------------------------------------------------------------------
Private Sub Txt_Neto_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Txt_Und = Me.Txt_Und - (19 / 100 * Me.Txt_Und)
Txt_Neto = Me.Txt_Cant * Me.Txt_Und
Me.Txt_Neto.Text = Format(Txt_Neto, "$#,##0")
End Sub
---------------------------------------------------------
Private Sub Txt_TotalNeto_Change()
Txt_TotalNeto = Format(Txt_Neto, "$#,##0")
End Sub
Private Sub Txt_Und_Change()
Me.Txt_Und.Text = Format(Txt_Und, "$#,##0")
End Sub
-------------------------------------------------------
Private Sub UserForm_Initialize()
Dim sd As New Collection
Dim celda As Range
Dim dato
Dim r As String
Dim uf As Integer
Application.ScreenUpdating = False
On Error Resume Next
Combo_Departamento.Clear
Sheets("ListadoInventario").Select
Range("H2").Select
uf = Range("H" & Rows.Count).End(xlUp).Row
r = "H2:H" & uf
For Each celda In Range(r)
sd.Add celda.Value, CStr(celda.Value)
Next celda
For Each dato In sd
Cbo_Departamento.AddItem dato
Next dato
Application.ScreenUpdating = True
Set h1 = Sheets("Cotizaciones")
u = h1.Range("A" & Rows.Count).End(xlUp).Row
Txt_Folio = h1.Range("A" & u) + 1
Label_Fecha.Caption = fecha & Date
End SubPor favor, puede revisarlo???
Muchas gracias...
- Compartir respuesta