Para Dante - Modificar y eliminar datos en un listbox filtrado

Estimado Dante

Necesito modificar un registro tomado del listbox con la información filtrada y que esto también afecte a la hoja de excel, también requiero borrar un registro tomado del listbox con la información filtrada y que esto también afecte a la hoja de excel.

Gracias.

1 respuesta

Respuesta
1

Te anexo todas las macros, ya que la mayoría sufrió cambios. Estoy utilizando la columna "S" para poner la numeración de la fila, si agregas columnas, se deberá modificar la macro.

Private Sub Actualizar_Click()
    If ListBox1.ListIndex = -1 Then Exit Sub
    f = ListBox1.List(ListBox1.ListIndex, 18)
    r = ListBox1.ListIndex
    Sheets("LVT").Range("A" & f) = (TextBox2)
    Sheets("LVT").Range("B" & f) = Format(TextBox3, "mm/dd/yyyy")
    For i = 4 To 12
       Sheets("LVT").Cells(f, i - 1) = Controls("TextBox" & i)
    Next
    Call filtrar
    ListBox1.ListIndex = r
End Sub
Private Sub ComboBox1_Change()
'Por.Dante Amor
    filtrar
End Sub
Private Sub ComboBox2_Change()
'Por.Dante Amor
    filtrar
End Sub
Private Sub ComboBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    KeyAscii = 0
End Sub
Private Sub Eliminar_Click()
'Por.Dante Amor
    If ListBox1.ListIndex = -1 Then Exit Sub
    Pregunta = MsgBox("Está seguro de eliminar el registro?", vbYesNo + vbQuestion, "EXCELeINFO")
    If Pregunta = vbYes Then
        f = ListBox1.List(ListBox1.ListIndex, 18)
        Rows(f).Delete
        Call filtrar
    End If
    If ListBox1.ListCount > 0 Then
        ListBox1.ListIndex = 0
    End If
End Sub
Private Sub ListBox1_Click()
'Por.Dante Amor
    TextBox2.Text = (ListBox1.Column(0))
    TextBox3.Text = CDate(ListBox1.Column(1))
    For i = 4 To 12
       Controls("TextBox" & i) = ListBox1.Column(i - 2)
    Next
    TextBox2.SetFocus
    TextBox2.SelStart = 0
    TextBox2.SelLength = Len(TextBox2)
End Sub
Sub filtrar()
'Por.Dante Amor
    Set h1 = Sheets("LVT")
    Set h2 = Sheets("tmp")
    Set h3 = Sheets("PERIODOS")
    'Application.ScreenUpdating = False
    '
    If h1.FilterMode Then h1.ShowAllData
    h2.Range("A:S").Clear
    per = ""
    suc = IIf(ComboBox1 = "", "", Val(ComboBox1))
    If ComboBox2 <> "" And ComboBox2.ListIndex > -1 Then
        per = h3.Cells(ComboBox2.ListIndex + 1, "A")
    End If
    h2.Range("Y2") = suc
    h2.Range("Z2") = per
    '
    u = h1.Range("A" & Rows.Count).End(xlUp).Row
    h1.[S1] = "num"
    h1.[S2] = 2
    h1.[S3] = 3
    If u > 2 Then
        h1.Range("S2:S3").AutoFill h1.Range("S2:S" & u)
    End If
    '
    h1.Range("A1:S" & u).AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=h2.Range("Y1:Z2"), _
        CopyToRange:=h2.Range("A1"), Unique:=False
    '
    ListBox1.ColumnCount = 19
    ListBox1.ColumnHeads = False
    ListBox1.ColumnWidths = "60;60;60;60;60;60;60;60;60;60;60;0;0;0;0;0;0;0;0"
    If h2.Range("A2") <> "" Then
        ListBox1.RowSource = "tmp!A2:S" & Sheets("tmp").Range("A" & Rows.Count).End(xlUp).Row
    Else
        ListBox1.RowSource = ""
    End If
    h1.Range("S:S").ClearContents
End Sub

Va también la versión 2 del archivo.

https://www.dropbox.com/s/g7ln3j73dy2bub1/prueba%20DAM2.xlsm?dl=0 

Saludos. Dante Amor

No olvides valorar la respuesta.

Excelente

Solo un detalle el botón eliminar me da error. Se podrá corregir.

¿Y qué error te aparece? ¿Y en qué línea se detiene?

¿Qué pasos haces antes de presionar el botón?

Error 1004

Error en el método autofill de la clase range

Hice varias pruebas. Primero modifique una registro y al tratar de eliminar otro registro se detiene la macro. También trate de eliminar directamente el registro sin ninguna acción anterior pero el código se detiene.

Este es el código y se detiene don de esta la letra negrita

Sub filtrar()
'Por.Dante Amor
Set h1 = Sheets("LVT")
Set h2 = Sheets("tmp")
Set h3 = Sheets("PERIODOS")
'Application.ScreenUpdating = False
'
If h1.FilterMode Then h1.ShowAllData
h2.Range("A:S").Clear
per = ""
suc = IIf(ComboBox1 = "", "", Val(ComboBox1))
If ComboBox2 <> "" And ComboBox2.ListIndex > -1 Then
per = h3.Cells(ComboBox2.ListIndex + 1, "A")
End If
h2.Range("Y2") = suc
h2.Range("Z2") = per
'
u = h1.Range("A" & Rows.Count).End(xlUp).Row
h1.[S1] = "num"
h1.[S2] = 2
h1.[S3] = 3
If u > 2 Then
h1.Range("S2:S3").AutoFill h1.Range("S2:S" & u)
End If
'
h1.Range("A1:S" & u).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=h2.Range("Y1:Z2"), _
CopyToRange:=h2.Range("A1"), Unique:=False
'
ListBox1.ColumnCount = 19
ListBox1.ColumnHeads = False
ListBox1.ColumnWidths = "60;60;60;60;60;60;60;60;60;60;60;0;0;0;0;0;0;0;0"
If h2.Range("A2") <> "" Then
ListBox1.RowSource = "tmp!A2:S" & Sheets("tmp").Range("A" & Rows.Count).End(xlUp).Row
Else
ListBox1.RowSource = ""
End If
h1.Range("S:S").ClearContents
End Sub

Cambia en la macro

If u > 2 Then

Por 

If u > 3 Then

¡Gracias!

Muchas gracias ahora esta perfecto

Estimado dante:

Lamento molestarte nuevamente.

Hice la corrección que me diste, funciona de maravilla, cuando volví a abrir el formulario ya no funcionaba.

https://mega.co.nz/#!JdxF1TzZ!SwtrEcyX7cB7aq3oInt39CkvCBO_2d6FW3A3zRhYA0I 

Te envío el archivo

¿Y ahora qué no funciona?

¿Qué error te envía?

¿En qué línea se detiene?

¿Y explícame qué pasos estabas haciendo?

Prueba con el siguiente archivo, realicé varias pruebas y no me envió error. Pero le corregí un pequeño detalle.

https://www.dropbox.com/s/uepwkkc8o0i6rij/prueba%20DAM3.xlsm?dl=0 

En el nuevo archivo que me enviaste se lanza el siguiente error 1004

Error en el el método clear de la clase range.

Primero modifique una registro y al tratar de eliminar otro registro se detiene la macro. También trate de eliminar directamente el registro sin ninguna acción anterior pero el código se detiene.

Se detiene en la línea negrita

Sub filtrar()
'Por.Dante Amor
Set h1 = Sheets("LVT")
Set h2 = Sheets("tmp")
Set h3 = Sheets("PERIODOS")
'Application.ScreenUpdating = False
'
If h1.FilterMode Then h1.ShowAllData
h2.Range("A:S").Clear
per = ""
suc = IIf(ComboBox1 = "", "", Val(ComboBox1))
If ComboBox2 <> "" And ComboBox2.ListIndex > -1 Then
per = h3.Cells(ComboBox2.ListIndex + 1, "A")
End If
h2.Range("Y2") = suc
h2.Range("Z2") = per
'
u = h1.Range("A" & Rows.Count).End(xlUp).Row
h1.[S1] = "num"
h1.[S2] = 2
If u > 2 Then h1.[S3] = 3
If u > 3 Then h1.Range("S2:S3").AutoFill h1.Range("S2:S" & u)
'
h1.Range("A1:S" & u).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=h2.Range("Y1:Z2"), _
CopyToRange:=h2.Range("A1"), Unique:=False
'
ListBox1.ColumnCount = 19
ListBox1.ColumnHeads = False
ListBox1.ColumnWidths = "60;60;60;60;60;60;60;60;60;60;60;0;0;0;0;0;0;0;0"
If h2.Range("A2") <> "" Then
ListBox1.RowSource = "tmp!A2:S" & Sheets("tmp").Range("A" & Rows.Count).End(xlUp).Row
Else
ListBox1.RowSource = ""
End If
h1.Range("S:S").ClearContents
End Sub

Gracias

Es una instrucción de limpiar, no veo cuál es el problema.

¿Le agregaste algo a la macro?

¿Protegiste alguna hoja?

Tal vez te falte alguna referencia, revisa en el menú de VBA en Herramientas / Referencias y revisa que tengas activas las siguientes referencias

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas