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
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.
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
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
- Compartir respuesta