-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy path合同台账_修正.bas
347 lines (312 loc) · 12.7 KB
/
合同台账_修正.bas
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
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
Attribute VB_Name = "合同台账_修正"
Sub 修正合同台账包件()
Application.ScreenUpdating = False '禁刷新
On Error Resume Next
Dim arr1, arr, cx, i, c
Dim 批次, 厂家, 表行
With Worksheets("上报告")
Worksheets("上报告").Activate
表名 = ActiveSheet.Name
表行 = Sheets("上报告").Range("W" & Rows.Count).End(xlUp).Row '查询当前表占用的行
Worksheets("上报告").Activate
.Range("U2:V200").Interior.Pattern = xlNone '清理填充
.Range("U2:V200").ClearComments '清理批注
arr1 = Range("W2:W" & 表行)
'循环查找第一次出现的位置，修正ZH-03
For i = 1 To UBound(arr1)
If InStrRev(arr1(i, 1), "CRDH0004-CSXZ-WZqybd-2022-0037") Then
n = i + 1
Exit For
End If
Next
.Range("U" & n & ":" & "V" & n).ClearContents
.Range("V" & n).Value = "电缆附件"
.Range("U" & n).Value = "ZH-03"
.Range("V" & n).Interior.Color = 15773696
.Range("U" & n).Interior.Color = 15773696
.Range("V" & n).AddCommentThreaded ("蓝色为包件合并的合同，手动修正状态")
.Range("U" & n).AddCommentThreaded ("蓝色为包件合并的合同，手动修正状态")
'循环查找第一次出现的位置，修正BD-13
For i = 1 To UBound(arr1)
If InStrRev(arr1(i, 1), "CRDH0004-CSXZ-WZqybd-2022-0049") Then
n = i + 1
Exit For
End If
Next
.Range("U" & n).ClearContents
.Range("U" & n).Value = "BD-13"
.Range("U" & n).Interior.Color = 15773696
.Range("U" & n).AddCommentThreaded ("蓝色为包件合并的合同，手动修正状态")
'循环查找第一次出现的位置，修正XH-13
arr4 = Range("W2:W" & 表行)
For i = 1 To UBound(arr1)
If InStrRev(arr1(i, 1), "CRDH0004-CSXZ--WZxh-2022-0019") Then
n = i + 1
Exit For
End If
Next
.Range("U" & n).ClearContents
.Range("U" & n).Value = "XH-13"
.Range("U" & n).Interior.Color = 15773696
.Range("U" & n).AddCommentThreaded ("蓝色为包件合并的合同，手动修正状态")
'循环查找第一次出现的位置，修正ZH-02
For i = 1 To UBound(arr1)
If InStrRev(arr1(i, 1), "CRDH0004-CSXZ-WZqt-2022-0041") Then
n = i + 1
Exit For
End If
Next
.Range("U" & n).ClearContents
.Range("U" & n).Value = "ZH-02"
.Range("U" & n).Interior.Color = 15773696
.Range("U" & n).AddCommentThreaded ("蓝色为包件合并的合同，手动修正状态")
'循环查找第一次出现的位置，修正XH-23
For i = 1 To UBound(arr1)
If InStrRev(arr1(i, 1), "CRDH0004-CSXZ-WZxh-2022-0053") Then
n = i + 1
Exit For
End If
Next
.Range("U" & n).ClearContents
.Range("U" & n).Value = "XH-23"
.Range("U" & n).Interior.Color = 15773696
.Range("U" & n).AddCommentThreaded ("蓝色为包件合并的合同，手动修正状态")
'循环查找第一次出现的位置，修正DL-10
For i = 1 To UBound(arr1)
If InStrRev(arr1(i, 1), "CRDH0004-CSXZ-WZdl-2022-0055") Then
n = i + 1
Exit For
End If
Next
.Range("U" & n).ClearContents
.Range("U" & n).Value = "DL-10"
.Range("U" & n).Interior.Color = 15773696
.Range("U" & n).AddCommentThreaded ("蓝色为包件合并的合同，手动修正状态")
'循环查找第一次出现的位置，修正JCW-05
For i = 1 To UBound(arr1)
If InStrRev(arr1(i, 1), "CRDH0004-CSXZ-WZjcw-2022-0020") Then
n = i + 1
Exit For
End If
Next
.Range("U" & n).ClearContents
.Range("U" & n).Value = "JCW-05"
.Range("V" & n).Value = "钢芯铝绞线"
.Range("U" & n).Interior.Color = 15773696
.Range("U" & n).AddCommentThreaded ("蓝色为包件合并的合同，手动修正状态")
'循环查找第一次出现的位置，修正JCW-10
For i = 1 To UBound(arr1)
If InStrRev(arr1(i, 1), "CRDH0004-CSXZ-WZjcw-2022-0056") Then
n = i + 1
Exit For
End If
Next
.Range("U" & n & ":" & "V" & n).ClearContents
.Range("U" & n).Value = "JCW-10"
.Range("V" & n).Value = "H型钢柱1"
.Range("U" & n & ":" & "V" & n).Interior.Color = 15773696
.Range("U" & n).AddCommentThreaded ("蓝色为包件合并的合同，手动修正状态")
.Range("V" & n).AddCommentThreaded ("蓝色为包件合并的合同，手动修正状态")
'循环查找第一次出现的位置，修正ZH-05
For i = 1 To UBound(arr1)
If InStrRev(arr1(i, 1), "CRDH0004-CSXZ-WZqt-2022-0019") Then
n = i + 1
Exit For
End If
Next
.Range("U" & n).ClearContents
.Range("U" & n).Value = "ZH-05"
.Range("V" & n).Value = "电缆附件1"
.Range("U" & n).Interior.Color = 15773696
.Range("U" & n).AddCommentThreaded ("蓝色为包件合并的合同，手动修正状态")
'循环查找第一次出现的位置，修正JCW-13包件
For i = 1 To UBound(arr1)
If InStrRev(arr1(i, 1), "CRDH0004-CSXZ-WZjcw-2022-0035") Then
n = i + 1
Exit For
End If
Next
.Range("V" & n).ClearContents
.Range("V" & n).Value = "铜绞线"
.Range("V" & n).Interior.Color = 15773696
.Range("V" & n).AddCommentThreaded ("蓝色为包件合并的合同，手动修正状态")
'循环查找第一次出现的位置，修正JCW-07包件
For i = 1 To UBound(arr1)
If InStrRev(arr1(i, 1), "CRDH0004-CSXZ-WZjcw-2022-0050") Then
n = i + 1
Exit For
End If
Next
.Range("V" & n).ClearContents
.Range("V" & n).Value = "电缆卡具"
.Range("V" & n).Interior.Color = 15773696
.Range("V" & n).AddCommentThreaded ("蓝色为包件合并的合同，手动修正状态")
'循环查找第一次出现的位置，修正TX-10包件
For i = 1 To UBound(arr1)
If InStrRev(arr1(i, 1), "CRDH0004-CSXZ-WZtx-2022-0046") Then
n = i + 1
Exit For
End If
Next
.Range("V" & n).ClearContents
.Range("V" & n).Value = "综合配线柜"
.Range("V" & n).Interior.Color = 15773696
.Range("V" & n).AddCommentThreaded ("蓝色为包件合并的合同，手动修正状态")
'循环查找第一次出现的位置，修正XH-17包件
For i = 1 To UBound(arr1)
If InStrRev(arr1(i, 1), "CRDH0004-CSXZ--WZxh-2022-0017") Then
n = i + 1
Exit For
End If
Next
.Range("V" & n).ClearContents
.Range("V" & n).Value = "道岔缺口监测"
.Range("V" & n).Interior.Color = 15773696
.Range("V" & n).AddCommentThreaded ("蓝色为包件合并的合同，手动修正状态")
'循环查找第一次出现的位置，修正XH-27包件
For i = 1 To UBound(arr1)
If InStrRev(arr1(i, 1), "CRDH0004-CSXZ-WZxh-2022-0027") Then
n = i + 1
Exit For
End If
Next
.Range("V" & n).ClearContents
.Range("V" & n).Value = "道岔缺口监测1"
.Range("V" & n).Interior.Color = 15773696
.Range("V" & n).AddCommentThreaded ("蓝色为包件合并的合同，手动修正状态")
'循环查找第一次出现的位置，修正XH-18包件
For i = 1 To UBound(arr1)
If InStrRev(arr1(i, 1), "CRDH0004-CSXZ--WZxh-2022-0018") Then
n = i + 1
Exit For
End If
Next
'.Range("V" & n & ":" & "X" & n).ClearContents
.Range("V" & n).Value = "高压脉冲及补充"
.Range("X" & n).Value = "239130.00"
'.Range("W" & n).Value = "CRDH0004-CSXZ-WZxh-2022-0002"
.Range("U" & n & ":" & "X" & n).Interior.Color = 15773696
.Range("V" & n).AddCommentThreaded ("蓝色为包件合并的合同，手动修正状态")
'循环查找第一次出现的位置，修正XH-24包件
For i = 1 To UBound(arr1)
If InStrRev(arr1(i, 1), "CRDH0004-CSXZ-WZxh-2022-0028") Then
n = i + 1
Exit For
End If
Next
.Range("V" & n).ClearContents
.Range("V" & n).Value = "防雷分线盘1"
.Range("V" & n).Interior.Color = 15773696
.Range("V" & n).AddCommentThreaded ("蓝色为包件合并的合同，手动修正状态")
'循环查找第一次出现的位置，修正XH-29包件
For i = 1 To UBound(arr1)
If InStrRev(arr1(i, 1), "CRDH0004-CSXZ-WZxh-2022-0061") Then
n = i + 1
Exit For
End If
Next
.Range("V" & n).ClearContents
.Range("V" & n).Value = "线料、固线器1"
.Range("V" & n).Interior.Color = 15773696
.Range("V" & n).AddCommentThreaded ("蓝色为包件合并的合同，手动修正状态")
'循环查找第一次出现的位置，修正JCW-16包件
For i = 1 To UBound(arr1)
If InStrRev(arr1(i, 1), "CRDH0004-CSXZ-WZjcw-2022-0058") Then
n = i + 1
Exit For
End If
Next
.Range("V" & n).ClearContents
.Range("V" & n).Value = "电缆卡具1"
.Range("V" & n).Interior.Color = 15773696
.Range("V" & n).AddCommentThreaded ("蓝色为包件合并的合同，手动修正状态")
'循环查找第一次出现的位置，修正ZH-07
For i = 1 To UBound(arr1)
If InStrRev(arr1(i, 1), "CRDH0004-CSXZ-WZqt-2022-0057") Then
n = i + 1
Exit For
End If
Next
.Range("U" & n).ClearContents
.Range("U" & n).Value = "ZH-07"
.Range("U" & n).Interior.Color = 15773696
.Range("U" & n).AddCommentThreaded ("蓝色为包件合并的合同，手动修正状态")
'循环查找第一次出现的位置，修正DL-17
For i = 1 To UBound(arr1)
If InStrRev(arr1(i, 1), "CRDH0004-CSXZ-WZdl-2022-0057") Then
n = i + 1
Exit For
End If
Next
.Range("U" & n).ClearContents
.Range("U" & n).Value = "DL-17"
.Range("U" & n).Interior.Color = 15773696
.Range("U" & n).AddCommentThreaded ("蓝色为包件合并的合同，手动修正状态")
'循环查找第一次出现的位置，修正XH-11
For i = 1 To UBound(arr1)
If InStrRev(arr1(i, 1), "CRDH0004-CSXZ-WZxh-2022-0064") Then
n = i + 1
Exit For
End If
Next
.Range("V" & n).ClearContents
.Range("V" & n).Value = "道岔报警设备1"
.Range("V" & n).Interior.Color = 15773696
.Range("V" & n).AddCommentThreaded ("蓝色为包件合并的合同，手动修正状态")
'循环查找第一次出现的位置，修正XH-26
For i = 1 To UBound(arr1)
If InStrRev(arr1(i, 1), "CRDH0004-CSXZ-WZxh-2022-0065") Then
n = i + 1
Exit For
End If
Next
.Range("V" & n).ClearContents
.Range("V" & n).Value = "信号机1"
.Range("V" & n).Interior.Color = 15773696
.Range("V" & n).AddCommentThreaded ("蓝色为包件合并的合同，手动修正状态")
'循环查找第一次出现的位置，修正JCW-17 金具1
For i = 1 To UBound(arr1)
If InStrRev(arr1(i, 1), "CRDH0004-CSXZ-WZ-wj-2022-0024") Then
n = i + 1
Exit For
End If
Next
.Range("V" & n).ClearContents
.Range("V" & n).Value = "金具1"
.Range("V" & n).Interior.Color = 15773696
.Range("V" & n).AddCommentThreaded ("蓝色为包件合并的合同，手动修正状态")
'循环查找第一次出现的位置，修正TX-14 配线单元
For i = 1 To UBound(arr1)
If InStrRev(arr1(i, 1), "CRDH0004-CSXZ-WZ-txcl-2022-0024") Then
n = i + 1
Exit For
End If
Next
.Range("V" & n).ClearContents
.Range("V" & n).Value = "配线单元"
.Range("V" & n).Interior.Color = 15773696
.Range("V" & n).AddCommentThreaded ("蓝色为包件合并的合同，手动修正状态")
'循环查找第一次出现的位置，修正DL-18 户外隔离开关柜1
For i = 1 To UBound(arr1)
If InStrRev(arr1(i, 1), "CRDH0004-CSXZ-WZdl-2022-0051（2）") Then
n = i + 1
Exit For
End If
Next
.Range("V" & n).ClearContents
.Range("V" & n).Value = "户外隔离开关柜1"
.Range("V" & n).Interior.Color = 15773696
.Range("V" & n).AddCommentThreaded ("蓝色为包件合并的合同，手动修正状态")
'循环查找第一次出现的位置，修正DL-20 低压电缆3
For i = 1 To UBound(arr1)
If InStrRev(arr1(i, 1), "CRDH0004-CSXZ-WZ-dlcl-2022-0024") Then
n = i + 1
Exit For
End If
Next
.Range("V" & n).ClearContents
.Range("V" & n).Value = "低压电缆3"
.Range("V" & n).Interior.Color = 15773696
.Range("V" & n).AddCommentThreaded ("蓝色为包件合并的合同，手动修正状态")
End With
End Sub