¿Cómo crear un botón para determina ausencia en una planilla?
Dentro de una planilla de horarios, colocar tabla dinámica mostrando lcantiodad de ausencias y los vales de cada uno

1 respuesta
H o l a:
Te anexo la macro actualizada:
Sub BuscarAusente()
'Por.Dante Amor
Set h1 = Sheets("Hoja1")
u = h1.Range("A" & Rows.Count).End(xlUp).Row
If u = 1 Then u = 2
h1.Range("A2:A" & u).ClearContents
j = 2
For Each h In Sheets
If h.Name <> h1.Name Then
Set r = h.Cells
Set b = r.Find("ausente", Lookat:=xlPart)
If Not b Is Nothing Then
ncell = b.Address
Do
h1.Cells(j, "A") = h.Name
h1.Cells(j, "B") = b.Row
h1.Cells(j, "C") = h.Cells(b.Row, "A")
j = j + 1
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> ncell
End If
End If
Next
'
For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
hoja = h1.Cells(i, "A")
fila = h1.Cells(i, "B")
Set b = Sheets(hoja).Cells.Find("VALES", Lookat:=xlPart)
If Not b Is Nothing Then
h1.Cells(i, "D") = Sheets(hoja).Cells(fila, b.Column)
End If
Next
h1.PivotTables("Tabla dinámica1").PivotCache.Refresh
MsgBox "Búsqueda terminada"
End Sub‘
S a l u d o s . D a n t e A m o r. Recuerda valorar la respuesta. G r a c i a s
Anda perfecto lo único que si la persona no tiene ausencia no me aparece si tiene vale este apparece solo si la persona tubo alguna ausencia. Desde ya muchas gracias
H o l a:
Toma en cuenta que, en ningún momento mencionaste que se pusieran los vales tengan o no tengan ausencia, además en tu ejemplo que me enviaste no pusiste en ninguna parte una sola persona sin "ausente" y con vale.
De todas formas te anexo la macro actualizada:
Sub BuscarAusente()
'Por.Dante Amor
Set h1 = Sheets("Hoja1")
u = h1.Range("A" & Rows.Count).End(xlUp).Row
If u = 1 Then u = 2
h1.Range("A2:A" & u).ClearContents
j = 2
For Each h In Sheets
If h.Name <> h1.Name Then
Set r = h.Cells
Set b = r.Find("ausente", Lookat:=xlPart)
If Not b Is Nothing Then
ncell = b.Address
Do
h1.Cells(j, "A") = h.Name
h1.Cells(j, "B") = b.Row
h1.Cells(j, "C") = h.Cells(b.Row, "A")
j = j + 1
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> ncell
End If
End If
Next
'
For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
hoja = h1.Cells(i, "A")
fila = h1.Cells(i, "B")
Set b = Sheets(hoja).Cells.Find("VALES", Lookat:=xlPart)
If Not b Is Nothing Then
h1.Cells(i, "D") = Sheets(hoja).Cells(fila, b.Column)
End If
Next
'
For Each h In Sheets
If h.Name <> h1.Name Then
Set r = h.Cells
Set b = r.Find("vales", Lookat:=xlPart)
If Not b Is Nothing Then
col = b.Column
For i = b.Row + 1 To h.Cells(Rows.Count, col).End(xlUp).Row
If h.Cells(i, col) <> "" And IsNumeric(h.Cells(i, col)) Then
nom = h.Cells(i, "A")
Set b = h1.Columns("C").Find(nom, Lookat:=xlWhole)
If Not b Is Nothing Then
h1.Cells(b.Row, "D") = h.Cells(i, col)
Else
u = h1.Range("A" & Rows.Count).End(xlUp).Row + 1
h1.Cells(u, "A") = h.Name
h1.Cells(u, "B") = i
h1.Cells(u, "C") = nom
h1.Cells(u, "D") = h.Cells(i, col)
End If
End If
Next
End If
End If
Next
h1.PivotTables("Tabla dinámica1").PivotCache.Refresh
MsgBox "Búsqueda terminada"
End Sub‘
S a l u d o s . D a n t e A m o r. Recuerda valorar la respuesta. G r a c i a s
Te anexo la macro con un ajuste:
Sub BuscarAusente()
'Por.Dante Amor
Set h1 = Sheets("Hoja1")
u = h1.Range("A" & Rows.Count).End(xlUp).Row
If u = 1 Then u = 2
h1.Range("A2:E" & u).ClearContents
j = 2
For Each h In Sheets
If h.Name <> h1.Name Then
Set r = h.Cells
Set b = r.Find("ausente", Lookat:=xlPart)
If Not b Is Nothing Then
ncell = b.Address
Do
h1.Cells(j, "A") = h.Name
h1.Cells(j, "B") = b.Row
h1.Cells(j, "C") = h.Cells(b.Row, "A")
h1.Cells(j, "E") = 1
j = j + 1
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> ncell
End If
End If
Next
'
For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
hoja = h1.Cells(i, "A")
fila = h1.Cells(i, "B")
Set b = Sheets(hoja).Cells.Find("VALES", Lookat:=xlPart)
If Not b Is Nothing Then
h1.Cells(i, "D") = Sheets(hoja).Cells(fila, b.Column)
End If
Next
'
For Each h In Sheets
If h.Name <> h1.Name Then
Set r = h.Cells
Set b = r.Find("vales", Lookat:=xlPart)
If Not b Is Nothing Then
col = b.Column
For i = b.Row + 1 To h.Cells(Rows.Count, col).End(xlUp).Row
If h.Cells(i, col) <> "" And IsNumeric(h.Cells(i, col)) Then
nom = h.Cells(i, "A")
Set b = h1.Columns("C").Find(nom, Lookat:=xlWhole)
If Not b Is Nothing Then
h1.Cells(b.Row, "D") = h.Cells(i, col)
Else
u = h1.Range("A" & Rows.Count).End(xlUp).Row + 1
h1.Cells(u, "A") = h.Name
h1.Cells(u, "B") = i
h1.Cells(u, "C") = nom
h1.Cells(u, "D") = h.Cells(i, col)
End If
End If
Next
End If
End If
Next
h1.PivotTables("Tabla dinámica1").PivotCache.Refresh
MsgBox "Búsqueda terminada"
End Sub‘
S a l u d o s . D a n t e A m o r. Recuerda valorar la respuesta. G r a c i a s
- Compartir respuesta