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

Respuesta
2

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
Respuesta
1
Respuesta
1

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

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas