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

Respuesta
2

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

Deben aparecer solo desde la B a la G, 6 columnas pero Solo las líneas con datos

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

Respuesta
1

[email protected] este es mi correo detalla lo que necesitas en número

1 quiero esto

2 estos otro

3 que haga estos

¡Gracias! Perfecto Aneudys. Solo me explicas el porque acupaste arrastrando las celdas en la columna C Las vacías las ocupaste ¿para?

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas