标签：style class blog code tar ext
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199 |
Sub 月汇总() Dim MyPath, MyName, AWbNameDim Wb As Workbook, WbN As
StringDim G As LongDim num As
Long Application.ScreenUpdating = FalseMyPath = ActiveWorkbook.PathMyName = Dir(MyPath & "\" & "*.xls")AWbName = ActiveWorkbook.NameActiveWorkbook.Worksheets(1).Name = "BaseData"
‘工作表命名，基础数据表ActiveWorkbook.Worksheets(2).Name = "Summary"
‘工作表命名，数据汇总以及计算表Dim Data As
WorksheetDim Summary As
WorksheetSet Data = ThisWorkbook.Sheets("BaseData")Set Summary = ThisWorkbook.Sheets("Summary")Data.ActivateConst
NUM_WIDTH = 9Const
NAME_WIDTH1 = 50Const
NAME_WIDTH2 = 3Data.Columns(1).ColumnWidth = NUM_WIDTH ‘设置第 1 列宽度Data.Columns(2).ColumnWidth = NAME_WIDTH1 ‘设置第 2 列宽度Data.Columns(3).ColumnWidth = NAME_WIDTH2 ‘设置第 3 列宽度Data.Columns(4).ColumnWidth = 17 ‘设置第 4 列宽度Data.Columns(5).ColumnWidth = 5 ‘设置第 5 列宽度Data.Columns(6).ColumnWidth = 12 ‘设置第 6 列宽度Data.Cells.Clear ‘清空工作表的内容和格式Summary.Cells.Clear ‘清空工作表的内容和格‘Data.Rows.Interior.ColorIndex = 0 ‘清空所有背景色‘Summary.Rows.Interior.ColorIndex = 0 ‘清空所有背景色Data.Cells(Range("A65536").End(xlUp).Row, 2).HorizontalAlignment = 4 ‘右对齐num = 0Dim test As
Long‘============================ step1: 准备基础数据，整合到一张工作薄中的一张工作表 ============================Do While MyName <> "" If
MyName <> AWbName Then Set
Wb = Workbooks.Open(MyPath & "\" & MyName) ‘打开文件 num = num + 1 With
Workbooks(1).ActiveSheet If
num = 1 Then For
G = 1 To
Sheets.Count Wb.Sheets(G).UsedRange.Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1) ‘Range("A65536").End(xlUp).Row表示最后一个非空单元格的行号 Next Else For
G = 1 To
Sheets.Count Wb.Sheets(G).UsedRange.Offset(4, 0).Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1) Next End
If .Range("A65536").End(xlUp).Offset(1) = " FileName:"
+ MyName ‘记录工作簿名称，以示区分 test = .Range("A65536").End(xlUp).Row .Range("A"
& test & ":F"
& test).Merge ‘向右合并以工作簿名称为内容的单元格所在的6个单元格 .Range("A65536").End(xlUp).Interior.Color = RGB(162, 233, 240) ‘设置以工作簿名称为内容的单元格背景色，以示区分 .Range("A65536").End(xlUp).Font.Size = 10 WbN = WbN & Chr(13) & Wb.Name Wb.Close False End
With End
IfMyName = DirLoop‘============================ step1-2: 设置基础数据表样式 ============================Data.Range("A1").SelectData.Rows().RowHeight = 15Data.Cells.Font.Name = "Arial"Data.Range("A3:F3").MergeData.Range("A3") = Replace(Data.Range("A3").text, "Daily", "")With
Data.Range("A5").CurrentRegion .Rows(1).Interior.Color = RGB(0, 0, 128) ‘设置表头背景色，以示区分 .Rows(1).Font.Color = RGB(255, 255, 255) ‘设置表头文字颜色，以示区分 .HorizontalAlignment = xlLeft ‘水平居左 With
.Borders .Color = RGB(0, 0, 0) ‘边框颜色，黑色 .LineStyle = xlContinuous ‘边框线性，细线 .Weight = xlMedium ‘边框粗细，细 End
WithEnd With‘============================ step2: 筛选数据 ============================Summary.ActivateSummary.Columns(1).ColumnWidth = NUM_WIDTHSummary.Columns(2).ColumnWidth = NAME_WIDTH1 + NAME_WIDTH2Const
START_ROW = 6Summary.Cells(1, 1) = Data.Cells(5, 1)Summary.Cells(1, 2) = Data.Cells(5, 2)Summary.Rows(1).HorizontalAlignment = 4 ‘右对齐Dim
END_ROW As
IntegerEND_ROW = Data.Range("A65535").End(xlUp).RowDim
i As IntegerDim
flag As
Integerflag = 0Dim
isError As
BooleanisError = FalseDim
text As
StringDim
dbTime As
StringFor
i = START_ROW To
END_ROW Step
1 text = Trim(Data.Cells(i, 1).text) If
Len(Trim(dbTime)) = 0 Then dbTime = Trim(Data.Cells(i, 6).text) End
If If
Right(text, 4) <> ".xls"
Then ‘尚未到时间分隔点 Dim
myrange As
Range Set
myrange = Summary.Cells.Find(what:=text, LookIn:=xlValues) If
Not myrange Is
Nothing Then ‘dir num已经存在 Summary.Cells(myrange.Row, flag + 3) = Data.Cells(i, 4) If
Summary.Cells(myrange.Row, 2) <> Data.Cells(i, 2) Then Summary.Cells(myrange.Row, 2).Interior.ColorIndex = 3 Data.Cells(i, 2).Interior.ColorIndex = 3 isError = True End
If Else
‘dir num不存在 Summary.Cells(Range("A65536").End(xlUp).Offset(1, 0).Row, 1) = text Summary.Cells(Range("A65536").End(xlUp).Offset(0, 0).Row, 2) = Data.Cells(i, 2) Summary.Cells(Range("A65536").End(xlUp).Offset(0, 0).Row, 2).HorizontalAlignment = 4 ‘右对齐 Summary.Cells(Range("A65536").End(xlUp).Offset(0, 0).Row, flag + 3) = Data.Cells(i, 4) End
If Else
‘每隔一个时间分割点，标志位加1 Summary.Cells(1, flag + 3) = dbTime Summary.Columns(flag + 3).ColumnWidth = 14 flag = flag + 1 dbTime = "" End
IfNext‘============================ step3: 求和、求平均数 ============================Const
HEADER_SUM = "sum"Summary.Cells(1, flag + 3) = HEADER_SUM & "("
& flag & ")"Const
HEADER_AVG = "avg"Summary.Cells(1, flag + 4) = HEADER_AVG & "("
& flag & ")"Summary.Columns(flag + 3).ColumnWidth = 15 ‘设置求和列宽度Summary.Columns(flag + 4).ColumnWidth = 15 ‘设置求均值列宽度Dim
j As IntegerDim
SUM_END_ROW As
IntegerSUM_END_ROW = Summary.Range("A65535").End(xlUp).RowSet
st = Range("C2")Set
rt = st.Offset(0, flag - 1)For
j = 2 To
SUM_END_ROW Step
1 Summary.Cells(j, flag + 3).Formula = "=sum("
& st.Address & ":"
& rt.Address & ")" Summary.Cells(j, flag + 4).Formula = "="
& st.Offset(0, flag).Address & "/"
& flag Set
st = st.Offset(1) Set
rt = st.Offset(0, flag - 1)Next‘============================ step3-2: 设置基础数据表样式 ============================Summary.Rows().RowHeight = 15Summary.Cells.Font.Name = "Arial"Summary.Cells.Font.Size = 10Summary.Rows(1).Font.Bold = TrueWith
Summary.Range("A1").CurrentRegion .Rows(1).Interior.Color = RGB(0, 0, 128) ‘设置表头背景色，以示区分 .Rows(1).Font.Color = RGB(255, 255, 255) ‘设置表头文字颜色，以示区分 .HorizontalAlignment = xlLeft ‘水平居左 With
.Borders .Color = RGB(0, 0, 0) ‘边框颜色，黑色 .LineStyle = xlContinuous ‘边框线性，细线 .Weight = xlMedium ‘边框粗细，细 End
WithEnd
With‘============================ step4: 提示或警告 ============================Summary.Range("A1").SelectApplication.ScreenUpdating = TrueMsgBox "共合并了"
& num & "个工作薄下的全部工作表。如下："
& vbNewLine & WbN, vbInformation, "提示"If
isError Then Data.Activate Data.Range("A3").Select MsgBox "Error:"
& vbNewLine & vbNewLine & "Dealer Name出现不一致的情况！"
& vbNewLine & "请查看红色高亮的部分！", vbExclamation, "警告"End
IfActiveWorkbook.Save ‘Close Savechanges:=True‘Summary.Close Savechanges:=TrueEnd
Sub |
标签：style class blog code tar ext
原文地址：http://www.cnblogs.com/Elsie/p/3772403.html
