5.5.9-代码解析：sub_预警附件Excel生成¶
本过程是为了生成最终的Excel文件，如图5-4所示
代码如下
1 Sub sub_预警附件Excel生成(arr)
2 Application.DisplayAlerts = False
3
4 timeID1 = arr(1)
5 pointCount1 = arr(2)
6
7 currentPath = ThisWorkbook.Path
8 templateExcel = currentPath & "\预警模板.xlsx"
9
10 Set fso = CreateObject("Scripting.FileSystemObject")
11 Set currentFolder = fso.GetFolder(currentPath)
12
13 ' 获取上一级文件夹地址
14 Set upperFolder = currentFolder.parentFolder
15 outputAddress = upperFolder & "\【2】输出"
16 alertFileName = timeID1 & ".xlsx"
17 alertFileAddress = outputAddress & "\" & alertFileName
18 If Dir(alertFileAddress) <> "" Then
19 Kill alertFileAddress
20 End If
21
22 FileCopy templateExcel, alertFileAddress
23
24 Set wb = Workbooks.Open(alertFileAddress)
25 Set sht = wb.Worksheets(1)
26
27 yearInfo = CInt(Mid(timeID1, 6, 4))
28 monthInfo = CInt(Mid(timeID1, 10, 2))
29 dayInfo = CInt(Mid(timeID1, 12, 2))
30 hourInfo = CInt(Mid(timeID1, 14, 2))
31 minuteInfo = CInt(Mid(timeID1, 16, 2))
32 secondInfo = CInt(Mid(timeID1, 18, 2))
33
34 dateFormat = DateSerial(yearInfo, monthInfo, dayInfo)
35 timeFormat = TimeSerial(hourInfo, minuteInfo, secondInfo)
36 dateTimeFormat = dateFormat + timeFormat
37
38 ' 赋值给问题单
39 sht.Range("F3") = timeID1
40 sht.Range("H3") = pointCount1
41 sht.Range("B3") = dateTimeFormat
42
43 aimRate = 0.95
44
45 Set shtTemp1 = ThisWorkbook.Worksheets("Temp-最近5件合格率")
46 Set shtTemp2 = ThisWorkbook.Worksheets("Temp-不合格点")
47
48 latest1Rate = CDbl(shtTemp1.Range("A6"))
49
50 If latest1Rate < aimRate Then
51 rateStatus = "不合格"
52 ' 红色底色
53 With sht.Range("B2").Interior
54 .Pattern = xlSolid
55 .PatternColorIndex = xlAutomatic
56 .Color = 255
57 .TintAndShade = 0
58 .PatternTintAndShade = 0
59 End With
60 Else
61 rateStatus = "合格"
62 ' 绿色底色
63 With sht.Range("B2").Interior
64 .Pattern = xlSolid
65 .PatternColorIndex = xlAutomatic
66 .Color = 5287936
67 .TintAndShade = 0
68 .PatternTintAndShade = 0
69 End With
70 End If
71
72 ' 赋值给问题单
73 sht.Range("B2") = rateStatus
74 sht.Range("F2") = aimRate
75 sht.Range("H2") = latest1Rate
76
77 ' 更新最近5件合格率信息
78 k = 2
79 For j = 11 To 15 Step 1
80 sht.Cells(6, j) = shtTemp1.Cells(k, "A")
81 sht.Cells(7, j) = shtTemp1.Cells(k, "B")
82 k = k + 1
83 Next j
84
85 ' 更新超差点信息
86 ' 折线图及地毯图
87 maxRow = shtTemp2.Cells(Rows.Count, "A").End(xlUp).Row
88 ' 清空原数据
89 sht.Range("A13:H15").Cells.ClearContents
90 sht.Range("J18:O20").Cells.ClearContents
91
92 Set rngCarpet = sht.Range("A13:F15")
93 rngCarpet.Cells.ClearContents
94 ' 清除颜色和内容
95 With rngCarpet.Interior
96 .Pattern = xlNone
97 .TintAndShade = 0
98 .PatternTintAndShade = 0
99 End With
100
101 rowCountA = maxRow - 1
102 If rowCountA > 3 Then
103 rowCountA = 3
104 End If
105
106 If maxRow > 2 Then
107 ' 复制点名
108 sht.Range("J18").Resize(rowCountA, 1) = shtTemp2.Range("A2").Resize(rowCountA, 1).Value
109 ' 复制数据
110 sht.Range("J18").Offset(0, 1).Resize(rowCountA, 5) = shtTemp2.Range("D2").Resize(rowCountA, 5).Value
111
112 sht.Range("A13").Resize(rowCountA, 8) = shtTemp2.Range("A2").Resize(rowCountA, 8).Value
113
114 ElseIf maxRow = 2 Then '表示只有一个点
115 ' 更新折线图
116 sht.Range("J18") = shtTemp2.Range("A2")
117 sht.Range("J18").Offset(0, 1).Resize(1, 5) = shtTemp2.Range("D2").Resize(1, 5).Value
118 sht.Range("A13").Resize(1, 8) = shtTemp2.Range("D2").Resize(1, 8).Value
119
120 sht.Range("J19") = "上公差"
121 sht.Range("J20") = "下公差"
122 sht.Range("J19").Offset(0, 1).Resize(1, 5) = shtTemp2.Range("C2")
123 sht.Range("J20").Offset(0, 1).Resize(1, 5) = shtTemp2.Range("B2")
124
125 ' 更新地毯图部分数据
126 sht.Range("A13").Resize(rowCountA, 8) = shtTemp2.Range("A2").Resize(rowCountA, 8).Value
127 Else
128 Debug.Print ("无重点问题")
129 End If
130
131 ' 地毯图生成
132 Call sub_地毯图生成(sht)
133 wb.Save
134 wb.Close
135 End Sub
注意：以上代码中，最左侧没有数字序号的，表示是上一行的延续，是因为排版显示的问题，在VBE中是一行，所以无需换行符
关键代码解读
1）第27行：yearInfo = CInt(Mid(timeID1, 6, 4))。Cint是将其它类型转换为整数类型
2）第34行：dateFormat = DateSerial(yearInfo, monthInfo, dayInfo)。构建日期类型的变量，输入参数分别为年、月、日信息
3）第35行：timeFormat = TimeSerial(hourInfo, minuteInfo, secondInfo)。构建时间类型的变量，输入参数分别为时、分、秒信息
4）第48行：latest1Rate = CDbl(shtTemp1.Range("A6"))。CDbl是将其它类型转换为实数类型
5）第53行：sht.Range("B2").Interior.Color = 255。设置单元格填充色，关于单元格填充，可以采用录制宏生成一段代码，一般只需修改对应的颜色取值即可
6）第110行：sht.Range("J18").Offset(0, 1).Resize(1, 5) = shtTemp2.Range("D2").Resize(1, 5).Value。Resize批量复制单元格，Offset控制左上角起点位置，sht.Range(“J18”).Offset(0, 1)表示在J18单元格同一行的下一列。
Offset(行相对位置，列相对位置)：行位置正向下，负向上；列位置正向右，负向左