Excel macro note



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