Editar macro VBA Excel para cambio de carga de ListBox
Vengo en solicitud a ver si puedes acomodarme el código en un libro que te envío de ejemplo
Para que el ListBox "lista" del form Busca_Clientes se cargue desde la hoja Copias_Factura y no desde la Clientes sin tomar en cuenta las líneas vacías al abrir el formulario.
Te envío archivo
2 Respuestas
Te anexo el código
Private Sub UserForm_Initialize() 'Por.Dante Amor ' If PedirClave Then 'de la Function PedirClave() Application.ScreenUpdating = False FiltrarPor.AddItem "CÓDIGO" FiltrarPor.AddItem "NOMBRE" FiltrarPor.AddItem "CIUDAD" Call BuscaCambio 'Cargar Combo cmb_Pago cmb_Pago.List = Array("De Contado (Efectivo)", "De Contado con T.Débito", "De Contado con T.Crédito", _ "Pago Con Cheque", "Depósito/Transferencia", "Crédito 3 Días hábiles", "Crédito 7 Días hábiles", _ "Crédito 15 Días Hábiles", "Crédito 21 Días hábiles", "Crédito 30 Días hábiles") 'Cargar listbox Set h1 = Sheets("Copias_Factura") Set h2 = Sheets("Hoja1") h2.Cells.ClearContents h1.Rows(1).Copy h2.Rows(1) j = 2 For i = 2 To h1.Range("H" & Rows.Count).End(xlUp).Row If h1.Cells(i, "A") <> "" Then a1 = h1.Cells(i, "A") b1 = h1.Cells(i, "B") c1 = h1.Cells(i, "C") d1 = h1.Cells(i, "D") e1 = h1.Cells(i, "E") f1 = h1.Cells(i, "F") g1 = h1.Cells(i, "G") End If If h1.Cells(i, "H") <> "" Then h2.Cells(j, "A") = a1 h2.Cells(j, "B") = b1 h2.Cells(j, "C") = c1 h2.Cells(j, "D") = d1 h2.Cells(j, "E") = e1 h2.Cells(j, "F") = f1 h2.Cells(j, "G") = g1 h2.Cells(j, "H") = h1.Cells(i, "H") j = j + 1 End If Next lista.RowSource = h2.Name & "!A2:H" & h2.Range("A" & Rows.Count).End(xlUp).Row 'A partir de aqui pertenece al Modulo Varias_Macros Function PedirClave() ' Else ' End ' End If '-- Sheets("Factura").Select Application.ScreenUpdating = True End Sub
sal u dos
Hola Dante.
Si te das cuenta, se repiten las mismas facturas según las líneas que en la hoja Copias_Factura están vacías. Si desde A hasta G existen 4 filas vacías, 4 filas se repiten, A3, A4, A5, A6, la A7 ya es otra factura, A8, A9, A10 vacías, A12, A13, A14, vacías, A15 otra factura .
Las A3, A4, A5, A6, A8, A9, A10, A12, A13, A14 no tienen porque aparecer en el ListBox, ni que se repitan porque en la hoja estan vacias y no tienen porque existir en el ListBox "lista".
ListBox "lista" cargarse desde Copias_Factura sin tomar en cuenta las lineas vacias
Saludos
Código actualizado
Private Sub UserForm_Initialize() 'Por.Dante Amor ' If PedirClave Then 'de la Function PedirClave() Application.ScreenUpdating = False FiltrarPor.AddItem "CÓDIGO" FiltrarPor.AddItem "NOMBRE" FiltrarPor.AddItem "CIUDAD" Call BuscaCambio 'Cargar Combo cmb_Pago cmb_Pago.List = Array("De Contado (Efectivo)", "De Contado con T.Débito", "De Contado con T.Crédito", _ "Pago Con Cheque", "Depósito/Transferencia", "Crédito 3 Días hábiles", "Crédito 7 Días hábiles", _ "Crédito 15 Días Hábiles", "Crédito 21 Días hábiles", "Crédito 30 Días hábiles") 'Cargar listbox Set h1 = Sheets("Copias_Factura") Set h2 = Sheets("Hoja1") h2.Cells.ClearContents h1.Rows(1).Copy h2.Rows(1) j = 2 For i = 2 To h1.Range("H" & Rows.Count).End(xlUp).Row ' If h1.Cells(i, "A") <> "" Then ' a1 = h1.Cells(i, "A") ' b1 = h1.Cells(i, "B") ' c1 = h1.Cells(i, "C") ' d1 = h1.Cells(i, "D") ' e1 = h1.Cells(i, "E") ' f1 = h1.Cells(i, "F") ' g1 = h1.Cells(i, "G") ' End If If h1.Cells(i, "H") <> "" Then h2.Cells(j, "A") = h1.Cells(i, "A") h2.Cells(j, "B") = h1.Cells(i, "B") h2.Cells(j, "C") = h1.Cells(i, "C") h2.Cells(j, "D") = h1.Cells(i, "D") h2.Cells(j, "E") = h1.Cells(i, "E") h2.Cells(j, "F") = h1.Cells(i, "F") h2.Cells(j, "G") = h1.Cells(i, "G") h2.Cells(j, "H") = h1.Cells(i, "H") j = j + 1 End If Next lista.RowSource = h2.Name & "!A2:H" & h2.Range("A" & Rows.Count).End(xlUp).Row 'A partir de aqui pertenece al Modulo Varias_Macros Function PedirClave() ' Else ' End ' End If '-- Sheets("Factura").Select Application.ScreenUpdating = True End Sub
Hola Dante
Ya solo aparecen las línea sque deben aparecer pero aun aparecen las líneas vacías en el ListBox
Tienes que poner un ejemplo de lo que tienes y de lo que esperas como resultado en el listbox.
Haz un dibujo o haz la simulación en una hoja de excel, de lo contrario voy a crear macros y macros tratando de adivinar lo que necesitas.
Ok dante, sencillo; las filas vacías entre factura y factura de la B a la G en la hoja Copias_factura no aparezcan en el ListBox "lista"
Solo deben aparecer desde la B a la G, 6 columnas
Si fuera "sencillo" ya lo hubiéramos resuelto.
Pero si no me entregas un ejemplo de lo que tienes y del resultado que esperas, no entiendo lo que necesitas. Por tanto no podré generar macros y macros tratando de adivinar lo que necesitas.
Lo sencillo es que pongas un ejemplo, realiza un dibujo de lo que quieres en el listbox y lo pones aquí como imagen.
Te anexo el código actualizado
Private Sub UserForm_Initialize() 'Por.Dante Amor ' If PedirClave Then 'de la Function PedirClave() Application.ScreenUpdating = False FiltrarPor.AddItem "CÓDIGO" FiltrarPor.AddItem "NOMBRE" FiltrarPor.AddItem "CIUDAD" Call BuscaCambio 'Cargar Combo cmb_Pago cmb_Pago.List = Array("De Contado (Efectivo)", "De Contado con T.Débito", "De Contado con T.Crédito", _ "Pago Con Cheque", "Depósito/Transferencia", "Crédito 3 Días hábiles", "Crédito 7 Días hábiles", _ "Crédito 15 Días Hábiles", "Crédito 21 Días hábiles", "Crédito 30 Días hábiles") 'Cargar listbox Set h1 = Sheets("Copias_Factura") Set h2 = Sheets("Hoja1") h2.Cells.ClearContents h1.Rows(1).Copy h2.Rows(1) j = 2 For i = 2 To h1.Range("H" & Rows.Count).End(xlUp).Row ' If h1.Cells(i, "A") <> "" Then ' a1 = h1.Cells(i, "A") ' b1 = h1.Cells(i, "B") ' c1 = h1.Cells(i, "C") ' d1 = h1.Cells(i, "D") ' e1 = h1.Cells(i, "E") ' f1 = h1.Cells(i, "F") ' g1 = h1.Cells(i, "G") ' End If If h1.Cells(i, "A") <> "" Then h2.Cells(j, "A") = h1.Cells(i, "A") h2.Cells(j, "B") = h1.Cells(i, "B") h2.Cells(j, "C") = h1.Cells(i, "C") h2.Cells(j, "D") = h1.Cells(i, "D") h2.Cells(j, "E") = h1.Cells(i, "E") h2.Cells(j, "F") = h1.Cells(i, "F") h2.Cells(j, "G") = h1.Cells(i, "G") h2.Cells(j, "H") = h1.Cells(i, "H") j = j + 1 End If Next lista.RowSource = h2.Name & "!B2:G" & h2.Range("A" & Rows.Count).End(xlUp).Row 'A partir de aqui pertenece al Modulo Varias_Macros Function PedirClave() ' Else ' End ' End If '-- Sheets("Factura").Select Application.ScreenUpdating = True End Sub
sal u dos
- Compartir respuesta
[email protected] este es mi correo detalla lo que necesitas en número
1 quiero esto
2 estos otro
3 que haga estos
- Compartir respuesta