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 de Dante Amor
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 Subsal u dos
