Sub Summary()
'工作量汇总
startRow = 2 'start row
startColumn = 3 'start column
sheetsSum = Sheets.Count 'Sum of sheets include statistic and example
projectNum = 0
maxProject = 0
sumRowPerWeek = 53
sumRowForPro = 38
leters = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q")
'task type part to set week title
For i = 2 To sheetsSum - 2 Step 1
Cells(2, sheetsSum - i + 1) = Sheets(i).Name
Next
'task type part to set data
For cloumn = startColumn To sheetsSum Step 1
If Cells(startRow, cloumn) <> "" Then
Cells(500, 500) = "=counta(" & Cells(startRow, cloumn) & "!b" & sumRowPerWeek & ":y" & sumRowPerWeek & ")"
projects = Cells(500, 500).Value - 2
Cells(500, 500) = ""
temp = "!" & leters(projects)
For row = startRow + 1 To 17
Cells(row, cloumn) = "=" & Cells(startRow, cloumn) & temp & Trim(Str(sumRowPerWeek + row - 2))
Next
End If
Next
'Find proect num and find the sheet have max project
'For column = startColumn To sheetsSum Step 1
Cells(500, 500) = "=counta(Template_New!O2:O20)"
projectNum = Cells(500, 500)
'Next
'manhour/case/defect part to set projectName and weekTitle
For row = 3 To sheetsSum Step 1
Cells(sumRowForPro, sheetsSum - row + 3) = Cells(2, sheetsSum - row + 3)
formats = bound(sumRowForPro, sheetsSum - row + 3)
formats = middle(sumRowForPro, sheetsSum - row + 3)
formats = allFrame(sumRowForPro, sheetsSum - row + 3)
Next
Cells(sumRowForPro, 1) = "Man-hours"
formats = Gray_50(sumRowForPro, 1)
formats = bound(sumRowForPro, 1)
formats = middle(sumRowForPro, 1)
formats = allFrame(sumRowForPro, 1)
For i = 0 To projectNum - 1 Step 1
row = sumRowForPro + 1 + i
Cells(row, 1).Select
Selection.Clear
formats = Gray_25(row, 1)
formats = left(row, 1)
formats = allFrame(row, 1)
Cells(row, 1) = "=Template_New" & "!" & "o" & i + 2
endRow = row
Next
Cells(endRow + 1, 1).Select
Selection.Clear
formats = Gray_50(endRow + 1, 1)
formats = bound(endRow + 1, 1)
formats = middle(endRow + 1, 1)
formats = allFrame(endRow, 1)
Cells(endRow + 1, 1) = "Case"
For i = 0 To projectNum - 1 Step 1
If i = 0 Then
row = endRow + 2 + i
Else
row = row + 1
End If
Cells(row, 1).Select
Selection.Clear
formats = Gray_25(row, 1)
formats = left(row, 1)
formats = allFrame(row, 1)
Cells(row, 1) = "=Template_New" & "!" & "o" & i + 2
endRow = row
Next
Cells(endRow + 1, 1).Select
Selection.Clear
formats = Gray_50(endRow + 1, 1)
formats = bound(endRow + 1, 1)
formats = middle(endRow + 1, 1)
formats = allFrame(endRow, 1)
Cells(endRow + 1, 1) = "Defect"
For i = 0 To projectNum - 1 Step 1
If i = 0 Then
row = endRow + 2 + i
Else
row = row + 1
End If
Cells(row, 1).Select
Selection.Clear
formats = Gray_25(row, 1)
formats = left(row, 1)
formats = allFrame(row, 1)
Cells(row, 1) = "=Template_New" & "!" & "o" & i + 2
endRow = row
Next
'manhour/case/defect part to set sum Formula
Cells(sumRowForPro + 1, 2).Select
Selection.Clear
Cells(sumRowForPro + 1, 2) = "=sum(c" & sumRowForPro + 1 & ":bz" & sumRowForPro + 1 & ")"
formats = right(sumRowForPro + 1, 2)
formats = allFrame(sumRowForPro + 1, 2)
Selection.AutoFill Destination:=Range("b" & sumRowForPro + 1 & ":b" & sumRowForPro + projectNum * 3 + 2), Type:=xlFillDefault
Cells(sumRowForPro, 2) = "=sum(b" & sumRowForPro + 1 & ":b" & sumRowForPro + projectNum & ")"
Cells(sumRowForPro + projectNum + 1, 2) = "=sum(b" & sumRowForPro + projectNum + 2 & ":b" & sumRowForPro + projectNum * 2 + 1 & ")"
Cells(sumRowForPro + projectNum * 2 + 2, 2) = "=sum(b" & sumRowForPro + projectNum * 2 + 3 & ":b" & sumRowForPro + projectNum * 3 + 2 & ")"
formats = Gray_25(sumRowForPro, 2)
formats = right(sumRowForPro, 2)
formats = Gray_25(sumRowForPro + projectNum + 1, 2)
formats = Gray_25(sumRowForPro + projectNum * 2 + 2, 2)
'manhour/case/defect part to set data
sumRowInPerWeek = 66
For cloumn = startColumn To sheetsSum Step 1
If Cells(sumRowForPro, cloumn) <> "" Then
Cells(500, 500) = "=counta(" & Cells(startRow, cloumn) & "!b" & sumRowPerWeek & ":y" & sumRowPerWeek & ")"
projects = Cells(500, 500) - 2
Cells(500, 500) = ""
For i = 0 To projects - 1
temp = Cells(startRow, cloumn) & "!" & leters(i)
Cells(500, 500) = "=" & temp & sumRowPerWeek
For j = 0 To projectNum - 1 Step 1
from = sumRowForPro + 1
If Cells(from + j, 1) = Cells(500, 500) Then
Cells(from + j, cloumn) = "=" & temp & sumRowInPerWeek
Cells(from + projectNum + 1 + j, cloumn) = "=" & temp & sumRowInPerWeek + 1
Cells(from + projectNum * 2 + 2 + j, cloumn) = "=" & temp & sumRowInPerWeek + 2
End If
Next
Next
End If
Next
'reset graph data
ActiveSheet.ChartObjects("图表 2").Activate
ActiveChart.PlotArea.Select
ActiveChart.SetSourceData Source:=Range( _
"'" & ActiveSheet.Name & "'!$A$" & sumRowForPro + 1 & ":$A$" & sumRowForPro + projectNum & ",'" & ActiveSheet.Name & "'!$B$" & sumRowForPro + 1 & ":$B$" & sumRowForPro + projectNum)
'Set case analysis
startSetAnysis = 71
caseAnayRowInPerWeek = 77
For cloumn = startColumn To sheetsSum Step 1
If Cells(startRow, cloumn) <> "" Then
j = 0
Cells(startSetAnysis - 1, cloumn) = Cells(startRow, cloumn)
For row = startSetAnysis To startSetAnysis + 9
Cells(row, cloumn) = "=" & Cells(startRow, cloumn) & "!" & leters(j) & caseAnayRowInPerWeek
j = j + 1
Next
End If
Next
'set font of 10 for all sheet
Cells.Select
With Selection.Font
.Name = "宋体"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
MsgBox "Complete."
End Sub
--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Sub ResetProjestInWeek()
'
'
'reset all the shheet
' sheetsSum = Sheets.Count
' For i = 2 To sheetsSum Step 1
' a = Sheets(i).Select
'end of reset all the sheet and you need to delete the "next" in the end of sub
rowId = 2
leters = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M")
Formula1 = "=SUMPRODUCT((G5:G39="
Formula2 = "53)*(C5:C39=B"
Formula3 = ")*(F5:F39))"
Cells(500, 500) = "=Template_New!O" & rowId
While Cells(500, 500).Value <> 0
column = rowId + 1
Cells(53, column) = Cells(500, 500)
formats = Gray_50(53, column)
formats = bound(53, column)
formats = middle(53, column)
formats = allFrame(53, column)
For taskRow = 54 To 65 Step 1
Cells(taskRow, column) = Formula1 & leters(rowId) & Formula2 & taskRow & Formula3
formats = back_null(taskRow, column)
formats = middle(taskRow, column)
formats = allFrame(taskRow, column)
Next
Cells(taskRow, column) = "=SUM(" & leters(rowId) & "54:" & leters(rowId) & "65)"
formats = Gray_25(taskRow, column)
formats = middle(taskRow, column)
formats = allFrame(taskRow, column)
Cells(taskRow + 1, column) = "=SUMPRODUCT((G5:G39=" & leters(rowId) & "53)*(J5:J39))"
formats = back_null(taskRow + 1, column)
formats = middle(taskRow + 1, column)
formats = allFrame(taskRow + 1, column)
Cells(taskRow + 2, column) = "=SUMPRODUCT((G5:G39=" & leters(rowId) & "53)*(K5:K39))"
formats = back_null(taskRow + 2, column)
formats = middle(taskRow + 2, column)
formats = allFrame(taskRow + 2, column)
rowId = rowId + 1
Cells(500, 500) = "=Template_New!O" & rowId
Wend
'set case and defect sumary
column = rowId + 1
Cells(53, column) = "小计"
formats = Gray_50(53, column)
formats = bound(53, column)
formats = middle(53, column)
formats = allFrame(53, column)
For taskRow = 54 To 68 Step 1
aa = "=SUM(C" & taskRow & ":" & leters(rowId - 1) & taskRow & ")"
Cells(taskRow, column) = "=SUM(C" & taskRow & ":" & leters(rowId - 1) & taskRow & ")"
formats = Gray_25(taskRow, column)
formats = middle(taskRow, column)
formats = allFrame(taskRow, column)
Next
'reset graph data
ActiveSheet.ChartObjects("图表 1").Activate
ActiveChart.PlotArea.Select
ActiveChart.SetSourceData Source:=Range( _
"'" & ActiveSheet.Name & "'!$B$54:$B$65,'" & ActiveSheet.Name & "'!$" & leters(rowId) & "$54:$" & leters(rowId) & "$65")
Cells.Select
With Selection.Font
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
'Next
MsgBox "Complete."
End Sub
--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Sub Merge()
'
' Merge 宏
'
''
sr = 2 'start row
sc = 1 'data start column for record in TotalRecord
ec = 11 'data end column for record in TotalRecord
se = Sheets.Count 'end column,same with shcou
tr = 2
'pn = 9 'task number
'tn = 12 'task type nubmer
'shcou = Sheets.Count 'same with se
Sheets("TotalRecord").Select
'get sheet name for each week
If se <> 3 Then
' For i = 2 To se - 2 Step 1
' Cells(2, 1 + i) = Sheets(i).Name
' Next
'merge daily data from each sheet for each record
For i = 2 To se - 2 'get sheet name
tsr = 0
tsn = 0
For rc = 5 To 39 'get each record row in a sheet
If (tsr + 1) Mod 5 <> 0 Then
tsr = tsr + 1
Else
tsr = 0
tsn = tsn + 1
End If
Sheets(i).Select
If Cells(rc, 3).Value <> "" Then
reporter = Cells(2, 8).Value
Sheets("TotalRecord").Select
Cells(tr, 1) = "=row() - 1"
'MsgBox Len(Trim(Str(Int(Sheets(i).Name) + tsn)))
If Len(Trim(Str(Int(Sheets(i).Name) + tsn))) < 4 Then
str1 = "0" + Trim(Str(Int(Sheets(i).Name) + tsn))
Cells(tr, 2) = "2015/" + Mid(str1, 1, 2) + "/" + Mid(str1, 3, 2)
Else
str1 = Trim(Str(Int(Sheets(i).Name) + tsn))
Cells(tr, 2) = "2015/" + Mid(str1, 1, 2) + "/" + Mid(str1, 3, 2)
End If
Sheets(i).Select
Range("C" & rc & ": K" & rc).Select
Selection.Copy
Sheets("TotalRecord").Select
Range("C" & tr).Select
ActiveSheet.Paste
Cells(tr, 12) = reporter
tr = tr + 1
End If
Next
Next
End If
Sheets("TotalRecord").Select
Range("A1").Select
End Sub