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 Sub
Por favor, puede revisarlo???
Muchas gracias...
- Compartir respuesta