Se
creó una macro que permite realizar un reporte sobre los días de atraso que
tienen asociados el área de TI de una empresa a los requerimientos de los
distintos departamentos. Este reporte se saca diario, ya que es necesario
conocer el estado actualizado de cada uno de los tickets asignados. Por lo que
es muy útil poder realizarlo con solo un botón y no estar haciendo todos los
días las distintas tablas dinámicas.
Sub CompletarBase()
'La Base que se descarga todos los días viene sin
el detalle de 2 campos que son
'cruciales para el análisis, así como lo son los
días de atraso de cada uno de los
'Ticket como el departamento al cual fue
Asignado, es por esto que se crea un botón
'Asociado a esta macro que realiza el proceso para
completar la base con los datos necesarios
'En la plantilla donde se debe pegar el archivo
descargado cuenta con una hoja llamada
'Departamento donde se busca el dato necesario.
La base que se descarga es la
siguiente:
Worksheets("Detalle en curso").Select
Range("A1").Select
' Se bebe saber que dia es hoy para poder sacar los
dias laborales que
' Lleva el Ticket en curso.
ActiveCell.FormulaR1C1 = "=TODAY()"
Columns("D:D").Select
Selection.Insert Shift:=xlToRight
Range("D1").Select
'Se calculan los dias habiles que han transcurrido.
ActiveCell.FormulaR1C1 =
"Dias de Atraso"
Range("D2").Select
ActiveCell.FormulaR1C1 =
"=NETWORKDAYS(RC[-1],R1C1,R2C1:R300C1)"
Range("D2").Select
ActiveCell.FormulaR1C1 =
"=NETWORKDAYS(RC[-1],R1C1,R2C1:R300C1)-1"
Range("D2").Select
Selection.AutoFill Destination:=Range("D2:D100")
Range("H1").Select
ActiveCell.FormulaR1C1 = "Departamento"
Range("H2").Select
ActiveCell.FormulaR1C1 =
"=VLOOKUP(RC[-1],Departamento!R1C1:R10C2,2,FALSE)"
Range("H2").Select
Selection.AutoFill Destination:=Range("H2:H100")
Range("H2:H100").Select
Range("J2").Select
ActiveWindow.SmallScroll Down:=-15
Range("H1").Select
Application.CutCopyMode = False
Range("C1").Select
End Sub
Luego
del Presionar el botón asociado a esta macro queda de la siguiente manera.
En
otra Hoja se pusieron dos botones para realizar distintos análisis. Y se asociaron a una Macro.
Sub PromediodiasdeatradoDepto()
'Se va a realizar una Tabla dinámica donde se
agrupe por departamento y se calculen
'Los días de Atraso promedio que tienen en sus
ticket
''Hay que destacar que la tabla dinámica no se
puede realizar en una hoja especifica por lo
'Se borran dos partes del código quedando lo
siguiente:
Range(Selection,
Selection.End(xlToRight)).Select
Range(Selection,
Selection.End(xlDown)).Select
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase,
SourceData:= _
"Detalle en curso!R1C2:R40C12",
Version:=xlPivotTableVersion10). _
CreatePivotTable
TableDestination:="", _
TableName:="Tabla dinámica2",
DefaultVersion:=xlPivotTableVersion10
With ActiveSheet.PivotTables("Tabla
dinámica2").PivotFields("Departamento")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("Tabla dinámica2").AddDataField
ActiveSheet.PivotTables _
("Tabla
dinámica2").PivotFields("Dias de Atraso"), "Suma de Dias de
Atraso", _
xlSum
With ActiveSheet.PivotTables("Tabla dinámica2").PivotFields( _
"Suma de Dias de Atraso")
.Caption = "Promedio
de Dias de Atraso"
.Function = xlAverage
End With
Range("B3:B8").Select
Selection.NumberFormat = "0"
Selection.NumberFormat = "0.0"
ActiveSheet.PivotTables("Tabla
dinámica2").PivotFields("Departamento"). _
AutoSort xlAscending,
"Promedio de Dias de Atraso", ActiveSheet.PivotTables( _
"Tabla
dinámica2").PivotColumnAxis.PivotLines(1), 1
Range("A1:B2").Select
Range("B2").Activate
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
'Luego
se crea un gráfico asociado a la tabla dinámica para que sea más fácil
'Analizar los datos. Se coloca en una posición específica y con un
tamaño especifico.
ActiveSheet.Shapes.AddChart.Select
ActiveChart.Parent.Name = "Promediodepartamento"
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=Range("$A$1:$B$8")
ActiveSheet.Shapes("Promediodepartamento").IncrementLeft -16.5
ActiveSheet.Shapes("Promediodepartamento").IncrementTop -79.5
ActiveSheet.Shapes("Promediodepartamento").ScaleWidth
1.4458333333, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes("Promediodepartamento").ScaleHeight
0.98090296, msoFalse, _
msoScaleFromTopLeft
ActiveChart.ShowAllFieldButtons = False
ActiveSheet.ChartObjects("Promediodepartamento").Activate
ActiveChart.ChartTitle.Select
ActiveChart.ChartTitle.Text =
"Promedio dias de atraso por Departamento"
Selection.Format.TextFrame2.TextRange.Characters.Text
= _
"Promedio
dias de atraso por Departamento"
With
Selection.Format.TextFrame2.TextRange.Characters(1, 40).ParagraphFormat
.TextDirection =
msoTextDirectionLeftToRight
.Alignment = msoAlignCenter
End With
With Selection.Format.TextFrame2.TextRange.Characters(1, 23).Font
.BaselineOffset = 0
.Bold = msoTrue
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(0, 0, 0)
.Fill.Transparency = 0
.Fill.Solid
.Size = 18
.Italic = msoFalse
.Kerning = 12
.Name = "+mn-lt"
.UnderlineStyle = msoNoUnderline
.Strike = msoNoStrike
End With
With Selection.Format.TextFrame2.TextRange.Characters(24, 17).Font
.BaselineOffset = 0
.Bold = msoTrue
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(0, 0, 0)
.Fill.Transparency = 0
.Fill.Solid
.Size = 18
.Italic = msoFalse
.Kerning = 12
.Name = "+mn-lt"
.UnderlineStyle = msoNoUnderline
.Strike = msoNoStrike
End With
ActiveChart.ChartArea.Select
Rows("1:22").Select
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin =
Application.InchesToPoints(0.7)
.RightMargin =
Application.InchesToPoints(0.7)
.TopMargin =
Application.InchesToPoints(0.75)
.BottomMargin =
Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin =
Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 0
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text =
""
.EvenPage.CenterHeader.Text =
""
.EvenPage.RightHeader.Text =
""
.EvenPage.LeftFooter.Text =
""
.EvenPage.CenterFooter.Text =
""
.EvenPage.RightFooter.Text =
""
.FirstPage.LeftHeader.Text =
""
.FirstPage.CenterHeader.Text =
""
.FirstPage.RightHeader.Text =
""
.FirstPage.LeftFooter.Text =
""
.FirstPage.CenterFooter.Text =
""
.FirstPage.RightFooter.Text
= ""
End With
'Se
crea la variable Hoy para guardar la fecha.
'Se
debe cortar y pegar los datos separados por un - dado que para guardar un
archivo
'no se
puede guardar con /, por lo que no servia poner Hoy().Pdf
Dim Hoy As String
Range("E2").Select
ActiveCell.FormulaR1C1 = "=TODAY()"
Range("F2").Select
ActiveCell.FormulaR1C1 = "=DAY(RC[-1])"
Range("G2").Select
ActiveCell.FormulaR1C1 = "=MONTH(RC[-2])"
Range("H2").Select
ActiveCell.FormulaR1C1 = "=YEAR(RC[-3])"
Range("I2").Select
ActiveCell.FormulaR1C1 =
"=RC[-3]&""-""&RC[-2]&""-""&RC[-1]"
Range("I3").Select
Hoy = Range("I2").Value
Application.PrintCommunication = True
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\dzamora\Desktop\Ranking\Analisis por Departamento"
& Hoy & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False,
_
OpenAfterPublish:=True
End Sub
Sub PromediodiasdeatradoAsing()
Solo
se cambian los datos de la tabla dinámica y genera la misma tabla y el mismo
grafico por Asignado, creando un PDF con el nombre: Análisis por
Asignado22-1-2014
Descargar Archivo
No hay comentarios:
Publicar un comentario