VBA的几个小Demo

Merge Daily

Sub MergeDaily_·ÏÆú()

'¹Ø±ÕÆÁÄ»ÏÔʾÓ뱨¾¯
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim newwork, oldwork As Workbook
Dim rng As Range
Dim i, m, n, x, y As Integer

Set oldwork = ThisWorkbook

'´ò¿ªÐÂÎļþ
Filename = Application.GetOpenFilename("Excel Îļþ ,*.xls;*.xlsx")

If Filename <> False Then
    Set newwork = Workbooks.Open(Filename)

    '¸´ÖÆÓÐÓÃÐÅÏ¢ÖÁDaily
    oldwork.Worksheets("raw_data").UsedRange.Clear
    m = newwork.Worksheets("RetestData").Rows(1).Find("ENG ID").Column
    newwork.Worksheets("RetestData").Columns(m).Copy
    '
    oldwork.Worksheets("raw_data").Range("A1").PasteSpecial Paste:=xlPasteValues
    

    
    'ɾ³ýÖظ´Ïî
    oldwork.Worksheets("raw_data").Columns(1).RemoveDuplicates Columns:=1, Header:=xlNo
    '
    newwork.Worksheets("StepID_OPID").UsedRange.Copy
    oldwork.Worksheets("raw_data").Range("B1").PasteSpecial Paste:=xlPasteValues
    
    
    '¸´ÖÆÓÐÓÃÐÅÏ¢ÖÁDaily_RetestData
    oldwork.Worksheets("RetestData").UsedRange.ClearContents
    newwork.Worksheets("RetestData").Columns(1).Copy
    oldwork.Worksheets("RetestData").Range("A1").PasteSpecial Paste:=xlPasteValues
    newwork.Worksheets("RetestData").Columns("H:N").Copy
    oldwork.Worksheets("RetestData").Range("B1").PasteSpecial Paste:=xlPasteValues
    i = oldwork.Worksheets("RetestData").Range("A1").CurrentRegion.Rows.Count
    With oldwork.Worksheets("RetestData")
        .Range("I1") = "OPER CODE1"
        .Range("J1") = "ENG CODE1"
        .Range("K1") = "OPER NEED REPAIR"
        .Range("L1") = "ENG NEED REPAIR"
        .Range("M1") = "NEED REPAIR MISS"
        .Range("N1") = "OPER CODE2"
        .Range("O1") = "ENG CODE2"
        .Range("I2").FormulaR1C1 = "=RIGHT(RC[-6],3)"
        .Range("J2").FormulaR1C1 = "=RIGHT(RC[-5],3)"
        .Range("K2").Formula = "=IFERROR(VLOOKUP(LEFT(A2,4)&C2,¸½¼þ!P:Q,2,0),""PASS"")"
        .Range("L2").Formula = "=IFERROR(VLOOKUP(LEFT(A2,4)&E2,¸½¼þ!P:Q,2,0),""PASS"")"
        .Range("M2").Formula = "=IF(K2=L2,0,1)"
        .Range("N2").FormulaR1C1 = "=MID(RC[-11],4,2)"
        .Range("O2").FormulaR1C1 = "=MID(RC[-10],4,2)"
        .Range("I2:O2").AutoFill Destination:=.Range("I2").Resize(i - 1, 7)
    End With

    '½«Îı¾±£´æµÄÊý×Öת»»ÎªÊý×Ö
    For n = 1 To 6
        oldwork.Worksheets("raw_data").Columns(n).TextToColumns DataType:=xlDelimited, ConsecutiveDelimiter:=True, Space:=False
    Next
    newwork.Close savechanges:=False
Else
    MsgBox ("ÄúûÓÐÑ¡ÔñÎļþ")
End If

'Èç¹û´æÔÚ·ÇÆ·ÖÊ×éÈËÔ±¸´ÅУ¬ÔòÍ˳ö³ÌÐò
If Worksheets("¸½¼þ").Range("C1") <> Worksheets("¸½¼þ").Range("D1") Then
    MsgBox ("´æÔÚ·ÇÆ·ÖÊ×éÈËÔ±¸´ÅÐ »ò Æ·ÖÊ×éÈËÔ±Ôö¼Óµ«Î´¸üи½¼þ" & vbCrLf & vbCrLf & "                        ÇëÊÖ¶¯Â¼ÈëÊý¾Ý")
    Exit Sub
End If

'
For x = 2 To 4

    oldwork.Worksheets(x).Activate
    y = oldwork.Worksheets(x).Range("C2").CurrentRegion.Rows.Count
    
    'Òþ²ØûÓÐ׼ȷÂʵİ༶Êý¾Ý
    If Worksheets(x).Cells(y, 3) <> "" Then
        Worksheets(x).Visible = True
    Else
        Worksheets(x).Visible = False
    End If
    
    
    'Òþ²ØûÓÐ׼ȷÂÊÊý¾ÝµÄOP
    For i = 2 To y
        If Cells(i, 3).Value <> "" Then
            Rows(i).Hidden = False
        Else
            Rows(i).Hidden = True
        End If
    Next
    
    '±ê¼ÇĤ²ã
    For i = 2 To y - 2
        Cells(1, 3).ClearContents
        If Cells(i, 5) <> "" Then
            Cells(1, 3) = Cells(i, 5)
            Exit For
        End If
    Next
    
    
    '±ê¼Ç×îºóÒ»¸öÊý¾Ý±êǩΪÂÌÉ«¼Ó´Ö
    oldwork.Worksheets(x).ChartObjects(1).Activate
    ActiveChart.SeriesCollection(1).DataLabels.Delete
    ActiveChart.SeriesCollection(1).ApplyDataLabels
    y = ActiveChart.SeriesCollection(1).Points.Count
    If y <> 0 Then
        For i = 1 To y
            ActiveChart.SeriesCollection(1).Points(i).DataLabel.Select
            With Selection.Format.TextFrame2.TextRange.Font
                If i <> y Then
                    .Fill.ForeColor.RGB = RGB(0, 0, 0)
                    .Bold = msoFalse
                Else
                    .Fill.ForeColor.RGB = RGB(0, 176, 80)
                    .Bold = msoTrue
                End If
            End With
         Next
     End If
    
Next
'
ThisWorkbook.Worksheets(1).Activate

'´ò¿ªÆÁÄ»ÏÔʾ
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Sub End_Daily_New()

'¹Ø±ÕÆÁÄ»ÏÔʾÓ뱨¾¯
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim str, class_name, str1, str2, s1, s2 As String, rng1, rng2, rng As Range
Dim i, j, m, n, x, y, wid, hig As Integer

str = Left(ThisWorkbook.Name, 2) & "/" & Mid(ThisWorkbook.Name, 4, 2)

'Ô³õÇå³ýÉÏÔÂÊý¾Ý
If Mid(ThisWorkbook.Name, 4, 2) = "01" Then

    n = Worksheets("²é×¼ÂÊBy ¸öÈË").Range("C2").CurrentRegion.Rows.Count - 2
    Worksheets("²é×¼ÂÊBy ¸öÈË").Range("E3").Resize(n, 31).ClearContents
    n = Worksheets("²éÈ«ÂÊBy ¸öÈË").Range("C2").CurrentRegion.Rows.Count - 2
    Worksheets("²éÈ«ÂÊBy ¸öÈË").Range("E3").Resize(n, 31).ClearContents
End If


'ÖÜÒ»Çå³ýTrendÊý¾Ý
If Application.WorksheetFunction.Text(str, "ddd") = "Mon" Then
   Worksheets("׼ȷÂÊTrend by°à±ð").Rows(2).Find("Mon").Offset(1, 0).Resize(4, 7).ClearContents
   Worksheets("׼ȷÂÊTrend by°à±ð").Rows(9).Find("Mon").Offset(1, 0).Resize(4, 7).ClearContents
End If
     
'ɾ³ýÊ×Ò³ËùÓÐͼƬ
Dim shp As Shape
For Each shp In ThisWorkbook.Worksheets(1).Shapes
    If shp.Type <> msoFormControl And shp.Type <> msoChart Then shp.Delete
Next

s1 = Application.WorksheetFunction.Text(str, "ddd")
Set rng1 = Worksheets("׼ȷÂÊTrend by°à±ð").Rows(2).Find(s1)
Set rng2 = Worksheets("׼ȷÂÊTrend by°à±ð").Rows(9).Find(s1)
ThisWorkbook.Worksheets(1).Range("A1").Value = "BP ÖÆÔ첿 ¼ì²â¿Æ ׼ȷÂÊ Daily Report£¨" & str & "£©"

'»ñÈ¡µ±ÌìÆ·ÖÊ×éÈËÔ±Ãûµ¥
str1 = ""
For i = 2 To 20
    If Worksheets("¸½¼þ").Cells(i, 2) <> "" Then
        'str1 = Worksheets("¸½¼þ").Cells(i, 2).Value
        str1 = str1 & "&" & Worksheets("¸½¼þ").Cells(i, 2).Value
    End If
Next
str1 = Right(str1, Len(str1) - 1)

''''''''''''''''''''''''''''''''''
n = 0
For x = 2 To 4

    If ThisWorkbook.Worksheets(x).Visible <> False Then
        
        n = n + 1
        'ÇóÈ¡¸Ã°àÈËÊý
        m = ThisWorkbook.Worksheets(x).Range("A1").CurrentRegion.Rows.Count - 2
        '׼ȷÂÊTrend by °à±ð
        rng1.Offset(x - 1, 0).Value = ThisWorkbook.Worksheets(x).Cells(Worksheets(x).Range("A1").CurrentRegion.Rows.Count, 3)
        rng2.Offset(x - 1, 0).Value = ThisWorkbook.Worksheets(x).Cells(Worksheets(x).Range("A1").CurrentRegion.Rows.Count, 4)
        '׼ȷÂÊTrend by OP
        s2 = Application.WorksheetFunction.Text(str, "d")
        'Set rng1 = ThisWorkbook.Worksheets(x + 4).Rows(1).Find(s2).Offset(2, 0)
        'ThisWorkbook.Worksheets(x).Range("C2").Resize(m, 1).Copy
        'rng2.PasteSpecial Paste:=xlPasteValues
        class_name = Left(Worksheets(x).Name, 2)
        
        i = ThisWorkbook.Worksheets("²é×¼ÂÊBy ¸öÈË").Columns(4).Find(class_name).Row
        j = ThisWorkbook.Worksheets("²é×¼ÂÊBy ¸öÈË").Rows(1).Find(s2).Column
        ThisWorkbook.Worksheets("²é×¼ÂÊBy ¸öÈË").Cells(i, j) = ThisWorkbook.Worksheets(x).Range("F1").Value
        ThisWorkbook.Worksheets(x).Range("C2").Resize(m, 1).Copy
        ThisWorkbook.Worksheets("²é×¼ÂÊBy ¸öÈË").Cells(i + 1, j).PasteSpecial Paste:=xlPasteValues
        
        i = ThisWorkbook.Worksheets("²éÈ«ÂÊBy ¸öÈË").Columns(4).Find(class_name).Row
        j = ThisWorkbook.Worksheets("²éÈ«ÂÊBy ¸öÈË").Rows(1).Find(s2).Column
        ThisWorkbook.Worksheets("²éÈ«ÂÊBy ¸öÈË").Cells(i, j) = ThisWorkbook.Worksheets(x).Range("F1").Value
        ThisWorkbook.Worksheets(x).Range("D2").Resize(m, 1).Copy
        ThisWorkbook.Worksheets("²éÈ«ÂÊBy ¸öÈË").Cells(i + 1, j).PasteSpecial Paste:=xlPasteValues
        
        ThisWorkbook.Worksheets(1).Rows("12:14").EntireRow.Hidden = True
         
        If n <= 3 Then
            If n = 3 Then
                ThisWorkbook.Worksheets(1).Rows("12:14").EntireRow.Hidden = False
            End If
            
            ThisWorkbook.Worksheets(1).Cells(3 * n + 3, 1).Value = n & "¡¢" & ThisWorkbook.Worksheets(x).Name & "¡¾Êä³öÈËÔ±£º" & str1 & "¡¿"
        
            '¸´ÖÆͼƬÖÁ»ã×Ü
            ThisWorkbook.Worksheets(x).Range("A1").Resize(m + 2, 15).CopyPicture
            ThisWorkbook.Worksheets(1).Activate
            'ThisWorkbook.Worksheets(1).Cells(7 + 3 * (n - 1), 1).RowHeight = ThisWorkbook.Worksheets(x).Range("A1").Height * (ThisWorkbook.Worksheets(x).Range("G2") + 2)
            ThisWorkbook.Worksheets(1).Cells(3 * n + 4, 1).Select
            wid = Selection.Width
            hig = Selection.Height
            ThisWorkbook.Worksheets(1).Paste Destination:=Selection
            With Selection.ShapeRange
                .LockAspectRatio = msoTrue
                .Width = wid - 2
                '.Height = hig - 3
                .IncrementLeft 1.2
                .IncrementTop 1.5
                'MsgBox .Height + 2
                If .Height + 2 > 400 Then
                    .Height = 400
                    ThisWorkbook.Worksheets(1).Rows(3 * n + 4).RowHeight = 402
                Else
                    ThisWorkbook.Worksheets(1).Rows(3 * n + 4).RowHeight = .Height + 2
                End If
            End With
            
            'ÈËÔ±ÄÜÁ¦·ÖÎö
            With ThisWorkbook.Worksheets(x)
                str2 = "°à×é/ÈËÔ±·ÖÎö£º" & Chr(10) & "¢Ù " & Left(.Name, 2) & "°à×é¡°" & .Range("I1").Value & "¡±£¬²é×¼ÂÊ" & .Range("I7") & "£¬²éÈ«ÂÊ" & .Range("I8") & "£»" & Chr(10) & "¢Ú " & .Range("H3") & "ÒÔÉÏ" & .Range("I3") & "ÈË£¬ÈËÔ±Õ¼±È" & .Range("I9") & "£»" & Chr(10) & "    " & .Range("H4") & "ÒÔÉÏ" & .Range("I4") & "ÈË£¬ÈËÔ±Õ¼±È" & .Range("I10") & "£»" & Chr(10) & "¢Û " & .Range("H5") & .Range("I5") & "Óë" & .Range("H6") & .Range("I6") & "ÈËÔ±£¬Òѽ»½Ó" & Left(.Name, 2) & "°à×鳤½øÐÐÕë¶ÔÐÔÅàѵ£»"
                Worksheets(1).Cells(3 * n + 5, 1).Value = str2
                Call Font_Style(Worksheets(1).Cells(3 * n + 5, 1))
            End With
           
''''''''''''''''''''''''
            
        End If
        
    End If
    
Next
'''''''''''''''''''''''''''''''''''''
rng1.Offset(4, 0).FormulaR1C1 = "=AVERAGE(R[-3]C:R[-1]C)"
rng2.Offset(4, 0).FormulaR1C1 = "=AVERAGE(R[-3]C:R[-1]C)"

Set rng = ThisWorkbook.Worksheets(5).Rows(2).Find("Sun").Offset(4, 0)
ThisWorkbook.Worksheets(5).Range("A1").Resize(rng.Row, rng.Column).CopyPicture
ThisWorkbook.Worksheets(1).Range("A3").Select
wid = Selection.Width
hig = Selection.Height
ThisWorkbook.Worksheets(1).Paste Destination:=Selection
With Selection.ShapeRange
    .LockAspectRatio = msoFalse
    .Width = wid - 2
    .Height = hig - 3
    .IncrementLeft 1.2
    .IncrementTop 1.5
End With
Set rng = ThisWorkbook.Worksheets(5).Rows(9).Find("Sun").Offset(4, 0)
ThisWorkbook.Worksheets(5).Range("A8").Resize(6, rng.Column).CopyPicture
ThisWorkbook.Worksheets(1).Range("A5").Select
wid = Selection.Width
hig = Selection.Height
ThisWorkbook.Worksheets(1).Paste Destination:=Selection
With Selection.ShapeRange
    .LockAspectRatio = msoFalse
    .Width = wid - 2
    .Height = hig - 3
    .IncrementLeft 1.2
    .IncrementTop 1.5
End With
        
        
'´ò¿ªÆÁÄ»ÏÔʾ
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

End_Daily

Sub End_Daily_·ÏÆú()

'¹Ø±ÕÆÁÄ»ÏÔʾÓ뱨¾¯
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim str, str1, str2, s1, s2 As String, rng1, rng2, rng As Range
Dim i, m, n, x, y, wid, hig As Integer

str = Left(ThisWorkbook.Name, 2) & "/" & Mid(ThisWorkbook.Name, 4, 2)

'Ô³õÇå³ýÉÏÔÂÊý¾Ý
If Mid(ThisWorkbook.Name, 4, 2) = "01" Then
For x = 6 To 8
    n = Worksheets(x).Range("C2").CurrentRegion.Rows.Count - 2
    Worksheets(x).Range("D3").Resize(n, 31).ClearContents
Next
End If


'ÖÜÒ»Çå³ýTrendÊý¾Ý
If Application.WorksheetFunction.Text(str, "ddd") = "Mon" Then
   Worksheets(5).Rows(2).Find("Mon").Offset(1, 0).Resize(4, 7).ClearContents
End If


'ɾ³ýÊ×Ò³ËùÓÐͼƬ
Dim shp As Shape
For Each shp In ThisWorkbook.Worksheets(1).Shapes
    If shp.Type <> msoFormControl And shp.Type <> msoChart Then shp.Delete
Next

s1 = Application.WorksheetFunction.Text(str, "ddd")
Set rng1 = Worksheets(5).Rows(2).Find(s1)
ThisWorkbook.Worksheets(1).Range("A1").Value = "BP ÖÆÔ첿 ¼ì²â¿Æ ׼ȷÂÊ Daily Report£¨" & str & "£©"

'»ñÈ¡µ±ÌìÆ·ÖÊ×éÈËÔ±Ãûµ¥
str1 = ""
For i = 1 To 20
    If Worksheets("¸½¼þ").Cells(i, 2) <> "" Then
        'str1 = Worksheets("¸½¼þ").Cells(i, 2).Value
        str1 = str1 & "&" & Worksheets("¸½¼þ").Cells(i, 2).Value
    End If
Next
str1 = Right(str1, Len(str1) - 1)

n = 0
For x = 2 To 4

    If ThisWorkbook.Worksheets(x).Visible <> False Then
        
        n = n + 1
        'ÇóÈ¡¸Ã°àÈËÊý
        m = ThisWorkbook.Worksheets(x).Range("A1").CurrentRegion.Rows.Count - 2
        '׼ȷÂÊTrend by °à±ð
        rng1.Offset(x - 1, 0).Value = ThisWorkbook.Worksheets(x).Cells(Worksheets(x).Range("A1").CurrentRegion.Rows.Count, 3)
        '׼ȷÂÊTrend by OP
        s2 = Application.WorksheetFunction.Text(str, "d")
        Set rng2 = ThisWorkbook.Worksheets(x + 4).Rows(1).Find(s2).Offset(2, 0)
        ThisWorkbook.Worksheets(x).Range("C2").Resize(m, 1).Copy
        rng2.PasteSpecial Paste:=xlPasteValues
        
        If n <= 2 Then
        
            ThisWorkbook.Worksheets(1).Cells(7 + 3 * (n - 1) - 1, 1).Value = n & "¡¢" & ThisWorkbook.Worksheets(x).Name & "¡¾Êä³öÈËÔ±£º" & str1 & "¡¿"
        
            '¸´ÖÆͼƬÖÁ»ã×Ü
            ThisWorkbook.Worksheets(x).Range("A1").Resize(m + 2, 15).CopyPicture
            ThisWorkbook.Worksheets(1).Activate
            'ThisWorkbook.Worksheets(1).Cells(7 + 3 * (n - 1), 1).RowHeight = ThisWorkbook.Worksheets(x).Range("A1").Height * (ThisWorkbook.Worksheets(x).Range("G2") + 2)
            ThisWorkbook.Worksheets(1).Cells(7 + 3 * (n - 1), 1).Select
            wid = Selection.Width
            hig = Selection.Height
            ThisWorkbook.Worksheets(1).Paste Destination:=Selection
            With Selection.ShapeRange
                .LockAspectRatio = msoTrue
                .Width = wid - 2
                '.Height = hig - 3
                .IncrementLeft 1.2
                .IncrementTop 1.5
                'MsgBox .Height + 2
                If .Height + 2 > 400 Then
                    .Height = 400
                    ThisWorkbook.Worksheets(1).Rows(7 + 3 * (n - 1)).RowHeight = 402
                Else
                    ThisWorkbook.Worksheets(1).Rows(7 + 3 * (n - 1)).RowHeight = .Height + 2
                End If
            End With
            
            'ÈËÔ±ÄÜÁ¦·ÖÎö
            'm = ThisWorkbook.Worksheets(3).Rows(3).CurrentRegion.Rows.Count
            With ThisWorkbook.Worksheets(x)
                str2 = "°à×é/ÈËÔ±·ÖÎö£º" & Chr(10) & "¢Ù" & Left(.Name, 2) & "°à×é¡°" & .Range("C1").Value & "¡±Æ½¾ù׼ȷÂÊ" & .Range("I2") & "£»" & Chr(10) & "¢Ú 90%׼ȷÂÊÒÔÉÏ" & .Range("G1").Value & "ÈË,ÈËÔ±Õ¼±È" & .Range("G3").Value & "£»" & Chr(10) & "¢Û ׼ȷÂÊ<" & .Range("I1") & "ÈËÔ±£¬Òѽ»½Ó" & Left(.Name, 2) & "°à×鳤½øÐÐÕë¶ÔÐÔÅàѵ£»"
                Worksheets(1).Cells(7 + 3 * (n - 1) + 1, 1).Value = str2
            End With


            Worksheets(1).Cells(7 + 3 * (n - 1) + 1, 1).Activate
            ActiveCell.Characters(Start:=16, Length:=8).Font.Color = -65536
            With ActiveCell.Characters(Start:=30, Length:=6).Font
                 .FontStyle = "¼Ó´Ö"
                 .Color = -11489280
            End With
            ActiveCell.Characters(Start:=39, Length:=7).Font.Color = -65536
            ActiveCell.Characters(Start:=48, Length:=2).Font.Color = -65536
            With ActiveCell.Characters(Start:=56, Length:=6).Font
                .FontStyle = "¼Ó´Ö"
                .Color = -11489280
            End With
            ActiveCell.Characters(Start:=65, Length:=11).Font.Color = -16776961
''''''''''''''''''''''''
            
        End If
        
    End If
    
Next
rng1.Offset(4, 0).FormulaR1C1 = "=AVERAGE(R[-3]C:R[-1]C)"
Set rng = ThisWorkbook.Worksheets(5).Rows(2).Find("Sun").Offset(4, 0)
ThisWorkbook.Worksheets(5).Range("A1").Resize(rng.Row, rng.Column).CopyPicture
ThisWorkbook.Worksheets(1).Range("A5").Select
wid = Selection.Width
hig = Selection.Height
ThisWorkbook.Worksheets(1).Paste Destination:=Selection
With Selection.ShapeRange
    .LockAspectRatio = msoFalse
    .Width = wid - 2
    .Height = hig - 3
    .IncrementLeft 1.2
    .IncrementTop 1.5
End With

ThisWorkbook.Worksheets(1).Activate
        
'´ò¿ªÆÁÄ»ÏÔʾ
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Sub End_Daily_New()

'¹Ø±ÕÆÁÄ»ÏÔʾÓ뱨¾¯
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim str, class_name, str1, str2, s1, s2 As String, rng1, rng2, rng As Range
Dim i, j, m, n, x, y, wid, hig As Integer

str = Left(ThisWorkbook.Name, 2) & "/" & Mid(ThisWorkbook.Name, 4, 2)

'Ô³õÇå³ýÉÏÔÂÊý¾Ý
If Mid(ThisWorkbook.Name, 4, 2) = "01" Then

    n = Worksheets("²é×¼ÂÊBy ¸öÈË").Range("C2").CurrentRegion.Rows.Count - 2
    Worksheets("²é×¼ÂÊBy ¸öÈË").Range("E3").Resize(n, 31).ClearContents
    n = Worksheets("²éÈ«ÂÊBy ¸öÈË").Range("C2").CurrentRegion.Rows.Count - 2
    Worksheets("²éÈ«ÂÊBy ¸öÈË").Range("E3").Resize(n, 31).ClearContents
End If


'ÖÜÒ»Çå³ýTrendÊý¾Ý
If Application.WorksheetFunction.Text(str, "ddd") = "Mon" Then
   Worksheets("׼ȷÂÊTrend by°à±ð").Rows(2).Find("Mon").Offset(1, 0).Resize(4, 7).ClearContents
   Worksheets("׼ȷÂÊTrend by°à±ð").Rows(9).Find("Mon").Offset(1, 0).Resize(4, 7).ClearContents
End If
     
'ɾ³ýÊ×Ò³ËùÓÐͼƬ
Dim shp As Shape
For Each shp In ThisWorkbook.Worksheets(1).Shapes
    If shp.Type <> msoFormControl And shp.Type <> msoChart Then shp.Delete
Next

s1 = Application.WorksheetFunction.Text(str, "ddd")
Set rng1 = Worksheets("׼ȷÂÊTrend by°à±ð").Rows(2).Find(s1)
Set rng2 = Worksheets("׼ȷÂÊTrend by°à±ð").Rows(9).Find(s1)
ThisWorkbook.Worksheets(1).Range("A1").Value = "BP ÖÆÔ첿 ¼ì²â¿Æ ׼ȷÂÊ Daily Report£¨" & str & "£©"

'»ñÈ¡µ±ÌìÆ·ÖÊ×éÈËÔ±Ãûµ¥
str1 = ""
For i = 2 To 20
    If Worksheets("¸½¼þ").Cells(i, 2) <> "" Then
        'str1 = Worksheets("¸½¼þ").Cells(i, 2).Value
        str1 = str1 & "&" & Worksheets("¸½¼þ").Cells(i, 2).Value
    End If
Next
str1 = Right(str1, Len(str1) - 1)

''''''''''''''''''''''''''''''''''
n = 0
For x = 2 To 4

    If ThisWorkbook.Worksheets(x).Visible <> False Then
        
        n = n + 1
        'ÇóÈ¡¸Ã°àÈËÊý
        m = ThisWorkbook.Worksheets(x).Range("A1").CurrentRegion.Rows.Count - 2
        '׼ȷÂÊTrend by °à±ð
        rng1.Offset(x - 1, 0).Value = ThisWorkbook.Worksheets(x).Cells(Worksheets(x).Range("A1").CurrentRegion.Rows.Count, 3)
        rng2.Offset(x - 1, 0).Value = ThisWorkbook.Worksheets(x).Cells(Worksheets(x).Range("A1").CurrentRegion.Rows.Count, 4)
        '׼ȷÂÊTrend by OP
        s2 = Application.WorksheetFunction.Text(str, "d")
        'Set rng1 = ThisWorkbook.Worksheets(x + 4).Rows(1).Find(s2).Offset(2, 0)
        'ThisWorkbook.Worksheets(x).Range("C2").Resize(m, 1).Copy
        'rng2.PasteSpecial Paste:=xlPasteValues
        class_name = Left(Worksheets(x).Name, 2)
        
        i = ThisWorkbook.Worksheets("²é×¼ÂÊBy ¸öÈË").Columns(4).Find(class_name).Row
        j = ThisWorkbook.Worksheets("²é×¼ÂÊBy ¸öÈË").Rows(1).Find(s2).Column
        ThisWorkbook.Worksheets("²é×¼ÂÊBy ¸öÈË").Cells(i, j) = ThisWorkbook.Worksheets(x).Range("F1").Value
        ThisWorkbook.Worksheets(x).Range("C2").Resize(m, 1).Copy
        ThisWorkbook.Worksheets("²é×¼ÂÊBy ¸öÈË").Cells(i + 1, j).PasteSpecial Paste:=xlPasteValues
        
        i = ThisWorkbook.Worksheets("²éÈ«ÂÊBy ¸öÈË").Columns(4).Find(class_name).Row
        j = ThisWorkbook.Worksheets("²éÈ«ÂÊBy ¸öÈË").Rows(1).Find(s2).Column
        ThisWorkbook.Worksheets("²éÈ«ÂÊBy ¸öÈË").Cells(i, j) = ThisWorkbook.Worksheets(x).Range("F1").Value
        ThisWorkbook.Worksheets(x).Range("D2").Resize(m, 1).Copy
        ThisWorkbook.Worksheets("²éÈ«ÂÊBy ¸öÈË").Cells(i + 1, j).PasteSpecial Paste:=xlPasteValues
        
        ThisWorkbook.Worksheets(1).Rows("12:14").EntireRow.Hidden = True
         
        If n <= 3 Then
            If n = 3 Then
                ThisWorkbook.Worksheets(1).Rows("12:14").EntireRow.Hidden = False
            End If
            
            ThisWorkbook.Worksheets(1).Cells(3 * n + 3, 1).Value = n & "¡¢" & ThisWorkbook.Worksheets(x).Name & "¡¾Êä³öÈËÔ±£º" & str1 & "¡¿"
        
            '¸´ÖÆͼƬÖÁ»ã×Ü
            ThisWorkbook.Worksheets(x).Range("A1").Resize(m + 2, 15).CopyPicture
            ThisWorkbook.Worksheets(1).Activate
            'ThisWorkbook.Worksheets(1).Cells(7 + 3 * (n - 1), 1).RowHeight = ThisWorkbook.Worksheets(x).Range("A1").Height * (ThisWorkbook.Worksheets(x).Range("G2") + 2)
            ThisWorkbook.Worksheets(1).Cells(3 * n + 4, 1).Select
            wid = Selection.Width
            hig = Selection.Height
            ThisWorkbook.Worksheets(1).Paste Destination:=Selection
            With Selection.ShapeRange
                .LockAspectRatio = msoTrue
                .Width = wid - 2
                '.Height = hig - 3
                .IncrementLeft 1.2
                .IncrementTop 1.5
                'MsgBox .Height + 2
                If .Height + 2 > 400 Then
                    .Height = 400
                    ThisWorkbook.Worksheets(1).Rows(3 * n + 4).RowHeight = 402
                Else
                    ThisWorkbook.Worksheets(1).Rows(3 * n + 4).RowHeight = .Height + 2
                End If
            End With
            
            'ÈËÔ±ÄÜÁ¦·ÖÎö
            With ThisWorkbook.Worksheets(x)
                str2 = "°à×é/ÈËÔ±·ÖÎö£º" & Chr(10) & "¢Ù " & Left(.Name, 2) & "°à×é¡°" & .Range("I1").Value & "¡±£¬²é×¼ÂÊ" & .Range("I7") & "£¬²éÈ«ÂÊ" & .Range("I8") & "£»" & Chr(10) & "¢Ú " & .Range("H3") & "ÒÔÉÏ" & .Range("I3") & "ÈË£¬ÈËÔ±Õ¼±È" & .Range("I9") & "£»" & Chr(10) & "    " & .Range("H4") & "ÒÔÉÏ" & .Range("I4") & "ÈË£¬ÈËÔ±Õ¼±È" & .Range("I10") & "£»" & Chr(10) & "¢Û " & .Range("H5") & .Range("I5") & "Óë" & .Range("H6") & .Range("I6") & "ÈËÔ±£¬Òѽ»½Ó" & Left(.Name, 2) & "°à×鳤½øÐÐÕë¶ÔÐÔÅàѵ£»"
                Worksheets(1).Cells(3 * n + 5, 1).Value = str2
                Call Font_Style(Worksheets(1).Cells(3 * n + 5, 1))
            End With
           
''''''''''''''''''''''''
            
        End If
        
    End If
    
Next
'''''''''''''''''''''''''''''''''''''
rng1.Offset(4, 0).FormulaR1C1 = "=AVERAGE(R[-3]C:R[-1]C)"
rng2.Offset(4, 0).FormulaR1C1 = "=AVERAGE(R[-3]C:R[-1]C)"

Set rng = ThisWorkbook.Worksheets(5).Rows(2).Find("Sun").Offset(4, 0)
ThisWorkbook.Worksheets(5).Range("A1").Resize(rng.Row, rng.Column).CopyPicture
ThisWorkbook.Worksheets(1).Range("A3").Select
wid = Selection.Width
hig = Selection.Height
ThisWorkbook.Worksheets(1).Paste Destination:=Selection
With Selection.ShapeRange
    .LockAspectRatio = msoFalse
    .Width = wid - 2
    .Height = hig - 3
    .IncrementLeft 1.2
    .IncrementTop 1.5
End With
Set rng = ThisWorkbook.Worksheets(5).Rows(9).Find("Sun").Offset(4, 0)
ThisWorkbook.Worksheets(5).Range("A8").Resize(6, rng.Column).CopyPicture
ThisWorkbook.Worksheets(1).Range("A5").Select
wid = Selection.Width
hig = Selection.Height
ThisWorkbook.Worksheets(1).Paste Destination:=Selection
With Selection.ShapeRange
    .LockAspectRatio = msoFalse
    .Width = wid - 2
    .Height = hig - 3
    .IncrementLeft 1.2
    .IncrementTop 1.5
End With
        
        
'´ò¿ªÆÁÄ»ÏÔʾ
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

KPI_check

Sub ¼¨Ð§ºË¶Ô()
    
    Dim newwork, oldwork As Workbook
    Dim repair_Count, i, j, x1, x2, y1, y2 As Integer
    Dim x, y As Integer
        
    Set oldwork = ThisWorkbook
    
    Filename = Application.GetOpenFilename("Excel Îļþ ,*.xls;*.xlsx")
    
    If Filename <> False Then
    
        Set newwork = Workbooks.Open(Filename)
        repair_Count = Application.WorksheetFunction.CountIf(newwork.Worksheets("׼ȷÂÊ").Range("E:E"), "Repair")
        flag = newwork.Worksheets("׼ȷÂÊ").Columns("E").Find("Repair").Row
        
        For x = flag To flag + repair_Count - 1
            For y = 1 To 31
                x1 = x
                y1 = newwork.Worksheets("׼ȷÂÊ").Rows(2).Find(y).Column
                
                
                x2 = oldwork.Worksheets("ÖÜ׼ȷÂÊ").Columns(2).Find(newwork.Worksheets("׼ȷÂÊ").Cells(x1, 2)).Row
                y2 = oldwork.Worksheets("ÖÜ׼ȷÂÊ").Rows(1).Find(y).Column
                
                If newwork.Worksheets("׼ȷÂÊ").Cells(x1, y1) <> oldwork.Worksheets("ÖÜ׼ȷÂÊ").Cells(x2, y2) Then
                    With oldwork.Worksheets("ÖÜ׼ȷÂÊ").Cells(x2, y2)
                            .FormatConditions.Delete
                            .Font.Color = -16776961
                            .Font.Bold = True
                    End With
                End If
            Next
        Next
        
        newwork.Close savechanges:=False
    End If
    
End Sub

delete&add op

Sub Delete_OP_ID()
    Dim i As Integer
    Dim str, class As String
    Dim rng1, rng2, rng3 As Range
    Application.ScreenUpdating = False
    i = 3
    Do While ThisWorkbook.Worksheets("¸½¼þ").Cells(i, 21) <> ""
        str = ThisWorkbook.Worksheets("¸½¼þ").Cells(i, 21).Value
        class = ThisWorkbook.Worksheets("¸½¼þ").Cells(i, 20).Value
        Set rng1 = ThisWorkbook.Worksheets(class + "׼ȷÂÊ").Columns(1).Find(str)
        Set rng2 = ThisWorkbook.Worksheets("²é×¼ÂÊBy ¸öÈË").Columns(2).Find(str)
        Set rng3 = ThisWorkbook.Worksheets("²éÈ«ÂÊBy ¸öÈË").Columns(2).Find(str)
        If rng1 Is Nothing Or rng2 Is Nothing Then
            MsgBox (str + " No Found")
            Exit Sub
        Else
            rng1.Resize(1, 6).Delete Shift:=xlUp
            rng2.EntireRow.Delete Shift:=xlUp
            rng3.EntireRow.Delete Shift:=xlUp
        End If
        ThisWorkbook.Worksheets("¸½¼þ").Cells(i, 20).Resize(1, 3).Delete Shift:=xlUp
        'i = i + 1
    Loop
    ThisWorkbook.Worksheets("¸½¼þ").Activate
    Application.ScreenUpdating = True
End Sub
Sub Add_OP_ID()
    Dim i As Integer
    Dim str, class As String
    Dim rng1, rng2, rng3 As Range
    Application.ScreenUpdating = False
    i = 3
    Do While ThisWorkbook.Worksheets("¸½¼þ").Cells(i, 25) <> ""
        str = ThisWorkbook.Worksheets("¸½¼þ").Cells(i, 25).Value
        class = ThisWorkbook.Worksheets("¸½¼þ").Cells(i, 24).Value
        Set rng1 = ThisWorkbook.Worksheets(class + "׼ȷÂÊ").Columns(1).Find(str)
        Set rng2 = ThisWorkbook.Worksheets("²é×¼ÂÊBy ¸öÈË").Columns(2).Find(str)
        If rng1 Is Nothing Or rng2 Is Nothing Then
            'Set rng1 = ThisWorkbook.Worksheets(class + "׼ȷÂÊ").Columns(1).End(xlDown)
            Set rng1 = ThisWorkbook.Worksheets(class + "׼ȷÂÊ").Range("A3")
            Set rng2 = ThisWorkbook.Worksheets("²é×¼ÂÊBy ¸öÈË").Columns(4).Find(class).Offset(2, 0)
            Set rng3 = ThisWorkbook.Worksheets("²éÈ«ÂÊBy ¸öÈË").Columns(4).Find(class).Offset(2, 0)

            'ThisWorkbook.Worksheets(class + "׼ȷÂÊ").Rows(rng1.Row).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            rng1.Resize(1, 6).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            ThisWorkbook.Worksheets("²é×¼ÂÊBy ¸öÈË").Rows(rng2.Row).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            ThisWorkbook.Worksheets("²éÈ«ÂÊBy ¸öÈË").Rows(rng3.Row).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            
            ThisWorkbook.Worksheets("¸½¼þ").Cells(i, 25).Resize(1, 2).Copy
            rng1.Offset(-1, 0).PasteSpecial Paste:=xlPasteValues
            rng2.Offset(-1, -2).PasteSpecial Paste:=xlPasteValues
            rng2.Offset(-1, 0) = class
            rng3.Offset(-1, -2).PasteSpecial Paste:=xlPasteValues
            rng3.Offset(-1, 0) = class
            'MsgBox (rng2.Offset(-2, 33).Address)
            
            rng1.Offset(-2, 2).Resize(1, 4).AutoFill Destination:=rng1.Offset(-2, 2).Resize(2, 4), Type:=xlFillDefault
            rng2.Offset(-2, 32).AutoFill Destination:=rng2.Offset(-2, 32).Resize(2, 1), Type:=xlFillDefault
            rng3.Offset(-2, 32).AutoFill Destination:=rng3.Offset(-2, 32).Resize(2, 1), Type:=xlFillDefault
        Else
            MsgBox (CStr(str) + " Is Exist")
            Exit Sub
        End If
        ThisWorkbook.Worksheets("¸½¼þ").Cells(i, 24).Resize(1, 3).Delete Shift:=xlUp
        'i = i + 1
    Loop
    ThisWorkbook.Worksheets("¸½¼þ").Activate
    Application.ScreenUpdating = True
End Sub

Sub picture()
    Selection.ShapeRange.LockAspectRatio = msoFalse
    Selection.ShapeRange.Height = 127.5590551181
    Selection.ShapeRange.Width = 141.7322834646
End Sub

label_change

Sub DataLabels(x)
    
    Dim i, y As Integer

    Worksheets(2).ChartObjects(1).Activate
    ActiveChart.SeriesCollection(1).DataLabels.Delete
    ActiveChart.SeriesCollection(1).ApplyDataLabels
    y = ActiveChart.SeriesCollection(1).Points.Count
    If y <> 0 Then
        For i = 1 To y
            ActiveChart.SeriesCollection(1).Points(i).DataLabel.Select
            With Selection.Format.TextFrame2.TextRange.Font
                'If i <> y Then
                    .Fill.ForeColor.RGB = RGB(0, 0, 0)
                    .Bold = msoFalse
                'Else
                    '.Fill.ForeColor.RGB = RGB(0, 176, 80)
                    '.Bold = msoTrue
                'End If
            End With
         Next
     End If

    ActiveChart.SeriesCollection(2).DataLabels.Delete
    ActiveChart.SeriesCollection(2).ApplyDataLabels
    ActiveChart.SeriesCollection(2).DataLabels.Select
    ActiveChart.SetElement (msoElementDataLabelInsideBase)
    y = ActiveChart.SeriesCollection(2).Points.Count
    If y <> 0 Then
        For i = 1 To y
            ActiveChart.SeriesCollection(2).Points(i).DataLabel.Select
            With Selection.Format.TextFrame2.TextRange.Font
                'If i <> y Then
                    .Fill.ForeColor.RGB = RGB(0, 0, 0)
                    .Bold = msoFalse
                'Else
                    '.Fill.ForeColor.RGB = RGB(0, 176, 80)
                    '.Bold = msoTrue
                'End If
            End With
         Next
     End If
     

End Sub