S.O.S con MACRO
Hola tengo esta Macro que copie y Modifique algo pero no consigo que haga lo que quiero al fin:
Sub MacroEliminaDato()
'desarrollada por Elsamatilde
Dim PrimCoinc, busca
Dim filalibre, fila, ultfila As Integer
DATO = Sheets("A").Range("A2")
'se buscará registros en columna C de la Hoja2
Sheets("A").Select
ultfila = ActiveSheet.Range("B65536").End(xlUp).Row
'On Error Resume Next
Set busca = Sheets("A").Range("B2:B" & ultfila).Find(What:=DATO, LookIn:=xlValues, LookAt:=xlPart)
If Not busca Is Nothing Then
Primero = busca.Address
'comienza el bucle
Do
busca.EntireRow.Delete
'continúa la búsqueda
Set busca = Sheets("A").Range("B2:B" & ultfila).Find(What:=DATO, LookIn:=xlValues, LookAt:=xlPart)
'se repite la rutina hasta volver a la primer dirección guardada. Ahí termina el ciclo
Loop While Not busca Is Nothing And busca.Address <> Primero
Else
MsgBox "No se encontr´el dato"
End If
'se libera la variable
Set busca = Nothing
End Sub
Esta rutina funciona correctamente para eliminar datos pero yo la necesito para cargar los datos en un listbox ahora si quito la linea (busca.EntireRow.Delete) que es la que borra la fila entera no me funciona y siempre me lee el mismo dato.
De que manera puedo hacer que siga leyendo para ir encontrando las ocurrencias siguientes.
Gracias mil por la ayuda
Sub MacroEliminaDato()
'desarrollada por Elsamatilde
Dim PrimCoinc, busca
Dim filalibre, fila, ultfila As Integer
DATO = Sheets("A").Range("A2")
'se buscará registros en columna C de la Hoja2
Sheets("A").Select
ultfila = ActiveSheet.Range("B65536").End(xlUp).Row
'On Error Resume Next
Set busca = Sheets("A").Range("B2:B" & ultfila).Find(What:=DATO, LookIn:=xlValues, LookAt:=xlPart)
If Not busca Is Nothing Then
Primero = busca.Address
'comienza el bucle
Do
busca.EntireRow.Delete
'continúa la búsqueda
Set busca = Sheets("A").Range("B2:B" & ultfila).Find(What:=DATO, LookIn:=xlValues, LookAt:=xlPart)
'se repite la rutina hasta volver a la primer dirección guardada. Ahí termina el ciclo
Loop While Not busca Is Nothing And busca.Address <> Primero
Else
MsgBox "No se encontr´el dato"
End If
'se libera la variable
Set busca = Nothing
End Sub
Esta rutina funciona correctamente para eliminar datos pero yo la necesito para cargar los datos en un listbox ahora si quito la linea (busca.EntireRow.Delete) que es la que borra la fila entera no me funciona y siempre me lee el mismo dato.
De que manera puedo hacer que siga leyendo para ir encontrando las ocurrencias siguientes.
Gracias mil por la ayuda
Respuesta de Elsa Matilde
1
Siendo la autora de la rutina, te explico, que al eliminar 1 fila la búsqueda sigue con el resto de los registros.
Pero en tu caso donde necesitas llenar un listbox, debés utilizar FindNext.
Fíjate en las líneas que dejé en negrita. Utilicé un control en la hoja por eso aparece como ActiveSheet. Listbox1... ajustá este detalle.
Sub MacroEliminaDato()
'desarrollada por Elsamatilde
Dim PrimCoinc, busca
Dim filalibre, fila, ultfila As Integer
ActiveSheet.ListBox1.Clear 'opcional: limpiar previamente el cuadro
DATO = Sheets("A").Range("A2")
'se buscará registros en columna C de la Hoja2
Sheets("A").Select
ultfila = ActiveSheet.Range("B65536").End(xlUp).Row
'On Error Resume Next
Set busca = Sheets("A").Range("B2:B" & ultfila).Find(What:=DATO, LookIn:=xlValues, LookAt:=xlPart)
If Not busca Is Nothing Then
Primero = busca.Address
'comienza el bucle
Do
ActiveSheet. ListBox1. AddItem busca. Offset(0, 1) 'llena la lista con datos de la col C
'continúa la búsqueda
Set busca = Sheets("A").Range("B2:B" & ultfila).FindNext(busca)
'se repite la rutina hasta volver a la primer dirección guardada. Ahí termina el ciclo
Loop While Not busca Is Nothing And busca.Address <> Primero
Else
MsgBox "No se encontr´el dato"
End If
'se libera la variable
Set busca = Nothing
End Sub
Sdos
Elsa
* Encontrarás más ejemplos del uso de Set en mis manuales VBA
Pero en tu caso donde necesitas llenar un listbox, debés utilizar FindNext.
Fíjate en las líneas que dejé en negrita. Utilicé un control en la hoja por eso aparece como ActiveSheet. Listbox1... ajustá este detalle.
Sub MacroEliminaDato()
'desarrollada por Elsamatilde
Dim PrimCoinc, busca
Dim filalibre, fila, ultfila As Integer
ActiveSheet.ListBox1.Clear 'opcional: limpiar previamente el cuadro
DATO = Sheets("A").Range("A2")
'se buscará registros en columna C de la Hoja2
Sheets("A").Select
ultfila = ActiveSheet.Range("B65536").End(xlUp).Row
'On Error Resume Next
Set busca = Sheets("A").Range("B2:B" & ultfila).Find(What:=DATO, LookIn:=xlValues, LookAt:=xlPart)
If Not busca Is Nothing Then
Primero = busca.Address
'comienza el bucle
Do
ActiveSheet. ListBox1. AddItem busca. Offset(0, 1) 'llena la lista con datos de la col C
'continúa la búsqueda
Set busca = Sheets("A").Range("B2:B" & ultfila).FindNext(busca)
'se repite la rutina hasta volver a la primer dirección guardada. Ahí termina el ciclo
Loop While Not busca Is Nothing And busca.Address <> Primero
Else
MsgBox "No se encontr´el dato"
End If
'se libera la variable
Set busca = Nothing
End Sub
Sdos
Elsa
* Encontrarás más ejemplos del uso de Set en mis manuales VBA
Muchísimas gracias Elsa ahora si funciona correctamente como yo necesitaba. Pero si Ud me permite me voy a aprovechar de su gentileza y le solicito una ayudita más. ¿Es posible además de cargar al listbox el dato encontrado tomar el link o vinculo del esa celda para cargarlo por ejemplo en otro listbox oculto para luego cuando el usuario haga click en el listbox visible mediante la propiedad index llamo a ese vinculo?
Desde Argentina un abraso grande por su amabilidad !
Desde Argentina un abraso grande por su amabilidad !
Finalizá esta consulta y dejá la nueva en el tablón, así no mezclamos los tema, ya que ahora se trataría de 'relacionar' 2 listbox.
Mucha gente utiliza el buscador y si cada tema aparece en post distintos ayudamos entre todos.
Sdos
Elsa
Mucha gente utiliza el buscador y si cada tema aparece en post distintos ayudamos entre todos.
Sdos
Elsa
Felicitaciones por su excelente respuesta! Y muchas gracias por todo!
Ya solucione el otro tema por el que la consulte así que no la molesto más (por ahora jejej)
Ya solucione el otro tema por el que la consulte así que no la molesto más (por ahora jejej)
