¿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

Respuesta
4

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

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas