¿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