Macro Excel que elimina datos que no están en otra columna
Tengo dos hojas diferentes, cada una tiene x cantidad de columnas, así como x cantidad de filas. No obstante cada una tiene una columna que dice empresa, (columna "B:B" para ambas)
hoja1 = cierre
hoja2 = Detalle.
Lo que pretendo hacer es que tome la hoja cierre y elimine la fila completa, siempre y cuando esa empresa no esté en la columna de empresa para la hoja Detalle. Pero si llegase a estar se debe dejar.
Importante: la hoja cierre puede tener varias personas en una misma empresa. Los debe borrar todos si esa empresa no está en la hoja detalle, pero si llegase a estar los debe dejar.
¡Agradezco si me pueden dar una ayuda!, sé que hay que hacer un ciclo que permita validar registro a registro, pero no sé cómo hacer la validación.
3 respuestas
Te anexo la macro
Sub Eliminar_Empresa()
'Por Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("cierre")
Set h2 = Sheets("Detalle")
For i = h1.Range("B" & Rows.Count).End(xlUp).Row To 2 Step -1
Set b = h2.Columns("B").Find(h1.Cells(i, "B").Value, lookat:=xlWhole)
If b Is Nothing Then
h1.Rows(i).Delete
End If
Next
Application.ScreenUpdating = True
MsgBox "Fin"
End Sub'.[Sal u dos. Dante Amor. No olvides valorar la respuesta. '.[Avísame cualquier duda
Esta macro compara ambas columnas y agrupa las empresas de la hoja cierre en la hoja detalle, borrandolas todas a la vez es más eficiente que buscar 1 a 1 y borrar.
Sub eliminar_faltantes()
Dim x As WorksheetFunction
Set x = WorksheetFunction
Set h1 = Worksheets("cierre")
Set h2 = Worksheets("detalle")
Set detalle = h2.Range("a1").CurrentRegion
Set cierre = h1.Range("a1").CurrentRegion
With cierre
r = .Rows.Count: c = .Columns.Count
matriz = .Columns(2)
For i = 2 To r
empresa = .Cells(i)
CUENTA = x.CountIf(detalle.Columns(2), empresa) = 0
If CUENTA Then
.Cells(i, c + 1) = "x"
End If
Next i
Set cierre = .CurrentRegion
.Sort key1:=h1.Range(.Columns(c + 1).Address), order1:=xlAscending, Header:=xlYes
cuenta2 = x.CountIf(.Columns(c + 1), "x")
ask = MsgBox(cuenta2 & " REGISTROS LISTOS PARA SER BORRADOS, QUIERE BORRARLOS?", vbYesNo, "AVISO EXCEL")
confirma = ask = 6
If confirma Then
.Rows(2).Resize(cuenta2, c + 1).EntireRow.Delete
MsgBox (cuenta2 & " REGISTROS BORRADOS"), vbInformation, "AVISO EXCEL"
End If
End With
Set cierre = Nothing: Set detalles = Nothing
End Sub