Macro para extraer con una condición

Para Dante

Buenas tardes Dante. Necesito de tu apoyo otra vez.

Necesito que le des unos ajustes a la macro que no había considerado al principio.

Sub Contar_Areas()
'Por.Dante Amor
'
    '
    Application.ScreenUpdating = False
    Set h1 = Sheets("BIBLIOTECA")
    Set h2 = Sheets("Hoja2")
    h2.Cells.Clear
    u1 = h1.Range("I" & Rows.Count).End(xlUp).Row
    h1.Range("I3:I" & u1).Copy h2.Range("A1")
    u2 = h2.Range("A" & Rows.Count).End(xlUp).Row
    h2.Range("A1:A" & u2).RemoveDuplicates Columns:=1, Header:=xlYes
    u2 = h2.Range("A" & Rows.Count).End(xlUp).Row
    With h2.Range("B2:B" & u2)
        .FormulaR1C1 = "=COUNTIF('" & h1.Name & "'!C[7],Hoja2!RC[-1])"
        .Value = .Value
    End With
    Application.ScreenUpdating = True
    MsgBox "fin"
End Sub

En la hoja1 hay libros existentes y que no existen


Y con esa condición el resultado lo deseo así

1 respuesta

Respuesta
1

Te anexo la macro

Sub Contar_Areas()
'
'Por.Dante Amor
'
    '
    Application.ScreenUpdating = False
    Set h1 = Sheets("BIBLIOTECA")
    Set h2 = Sheets("Hoja2")
    h2.Cells.Clear
    u1 = h1.Range("I" & Rows.Count).End(xlUp).Row
    h1.Range("I3:I" & u1).Copy h2.Range("A1")
    u2 = h2.Range("A" & Rows.Count).End(xlUp).Row
    h2.Range("A1:A" & u2).RemoveDuplicates Columns:=1, Header:=xlYes
    u2 = h2.Range("A" & Rows.Count).End(xlUp).Row
    h2.Columns("A").Copy h2.Columns("D")
    With h2.Range("B2:B" & u2)
        .FormulaR1C1 = "=COUNTIFS(BIBLIOTECA!C9,Hoja2!RC[-1],BIBLIOTECA!C8,""Existe"")"
        .Value = .Value
    End With
    '
    With h2.Range("E2:E" & u2)
        .FormulaR1C1 = "=COUNTIFS(BIBLIOTECA!C9,Hoja2!RC[-1],BIBLIOTECA!C8,""No existe"")"
        .Value = .Value
    End With
    h2.[A1] = "Libros existentes"
    h2.[D1] = "Libros que existen"
    Application.ScreenUpdating = True
    MsgBox "fin"
End Sub

sal u dos

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas