Оптимизировать VBA код по скорости

@Gilza1983 · Регистрация: 03.05.2020

Студворк — интернет-сервис помощи студентам

Добрый день, форумчане!
Помогите оптимизировать код. Долго выполняется.

Visual Basic
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
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
Public Group As Long
 
Sub FirstAnaliz_Click()             'Первичный анализ. Расчет всех метрик
 
Sheets("IAE").Select                'Очистка всех листов с данными метрик
Range("A7:CC90000").Select
Selection.ClearContents
 
Sheets("ITAE").Select
Range("A7:CC90000").Select
Selection.ClearContents
 
Sheets("ISE").Select
Range("A7:CC90000").Select
Selection.ClearContents
 
Sheets("ITSE").Select
Range("A7:CC90000").Select
Selection.ClearContents
 
Sheets("ServiceFactor").Select
Range("A7:CC90000").Select
Selection.ClearContents
 
Sheets("StdDevPv").Select
Range("A7:CC90000").Select
Selection.ClearContents
 
Sheets("StdDev").Select
Range("A7:CC90000").Select
Selection.ClearContents
 
Sheets("Diagramms").Activate
                
h0 = 5          ' Начальный столбец данных
H = 0           'Текущий столбец в цикле
Group = 0       ' Счетчик групп mv,pv,sp,mode
Do Until H + h0 > k - 1     'вычисление текушей группы 
    g = H \ 4
    
    If H Mod 4 = 0 Then
        ITAEfunction (Group)    'Вызов функции расчета ITAE, IAE
        ITSEfunction (Group)    'Вызов функции расчета ITSE, ISE
        ServiceFactor (Group)   'Вызов функции расчета Service Factor
        StdDevPV (Group)        'Вызов функции расчета StdDevPV
        PercentSaturation (Group)   'Вызов функции расчета Процент выхода клапана
        StdDev (Group)          'Вызов функции расчета StdDev и StdDevPercent
       
    End If
    
    Group = g + 1
    H = H + 1
Loop
 
Sheets("Diagramms").Cells(2, 2).Value = "Введите номер регулятора (от 0 до " + CStr(Group - 1) + " )"
Sheets("Diagramms").Cells(2, 3).Value = 0
Module3.UpdateDiadramm_Click    'Обновление диаграмм
        
Worksheets("IAE").Calculate                     'Вычисление всех листов
Worksheets("ITAE").Calculate
Worksheets("ISE").Calculate
Worksheets("ITSE").Calculate
Worksheets("ServiceFactor").Calculate
Worksheets("StdDevPV").Calculate
Worksheets("PercentSaturation").Calculate
 
MsgBox "First analiz complete!"                 'Сообщение о завершении анализа
    
End Sub
 
Sub ITAEfunction(LocalGroup As Integer)             'Метрика ITAE, IAE
 
Dim IAEerr() As Variant
Dim TimeStamp, FirstTimestamp, SecondTimestamp As Double
Dim IAE As Double
 
ITAE = 0            'Начальное значение показателя
IAE = 0             'Начальное значение показателя
S = 7               'Начальная строка сбора данных
Count = 0           'Счетчик от 1 до 10 (минуты для интегрирования)
Flag = 0            'Флаг окончания подгруппы расчета Count<10
FirstRow = 7        'Переменная начальная строка периода
SecondRow = 7       'Переменная конечная строка периода
S_row = 7           'Переменная для счета строк вывода метрики ITAE
 
ReDim Preserve IAEerr(AvePeriod)
FirstTimestamp = CDbl(Sheets("MES").Cells(7, 1).Value)                          'сохранение начальной даты
    Do Until S > i - 1
        Sheets("IAE").Cells(S, 1 + 4 * LocalGroup) = Format(Sheets("MES").Cells(S, 1), "DD-MM-YYYY hh-mm-ss")                   'Перенос метки времени
        Sheets("IAE").Cells(S, 2 + 4 * LocalGroup) = Abs(Sheets("MES").Cells(S, 5 + 4 * LocalGroup) - Sheets("MES").Cells(S, 6 + 4 * LocalGroup))           'Расчет IAE=(PV-SP) по модулю
        
        If Sheets("MES").Cells(S, 7 + 4 * LocalGroup) = Sheets("MES").Cells(S + 1, 7 + 4 * LocalGroup) Then                 '   Сравнение смены режима MODE. Ложим в массив или за 10 минут или до смены режима
            Count = Count + 1
            IAEerr(Count) = Abs(Sheets("MES").Cells(S, 5 + 4 * LocalGroup) - Sheets("MES").Cells(S, 6 + 4 * LocalGroup))    '   сохранение в матрицу значение ошибки (PV-SP)
                                           
            Else
            Count = Count + 1
            IAEerr(Count) = Abs(Sheets("MES").Cells(S, 5 + 4 * LocalGroup) - Sheets("MES").Cells(S, 6 + 4 * LocalGroup))    '   сохранение в матрицу значение ошибки (PV-SP) 
                                           
            Flag = 1
                                    
        End If
        SecondTimestamp = CDbl(Sheets("MES").Cells(S, 1).Value)                                             'сохранение конечной даты
        
        Subcount = 1
        Sum = 0
        If Count = AvePeriod Or Flag = 1 Then
            SecondRow = S
            Do Until Subcount > Count
                Sum = Sum + (IAEerr(Subcount - 1) + IAEerr(Subcount)) / 2                                   ' Расчет суммы интеграла ошибок (метод трапеций) собраных за период усреднения или до смены режима
                Subcount = Subcount + 1
            Loop
            ITAE = Sum / Count                                                                              ' расчет среднего значения за период
            Sheets("ITAE").Cells(S_row, 2 + 4 * LocalGroup) = ITAE
            TimeStampITAE = Sheets("MES").Cells(SecondRow, 1).Value                                         ' Расчет и Вывод времени SecondTimeStamp
            Sheets("ITAE").Cells(S_row, 1 + 4 * LocalGroup) = Format(TimeStampITAE, "DD-MM-YYYY hh-mm-ss")
            Count = 0
            S_row = S_row + 1
            Else
        End If
        
        Flag = 0
        S = S + 1
        FirstRow = SecondRow
        FirstTimestamp = SecondTimestamp
        Sum = 0
                
    Loop
End Sub
 
Sub ITSEfunction(LocalGroup As Integer)                                         'Метрика ISE,ITSE. Сделано на подобии предыдушей метрики, но с квадратом
 
Dim ITSEerr() As Variant
Dim TimeStamp, FirstTimestamp, SecondTimestamp As Double
Dim ISE As Double
 
ITSE = 0
ISE = 0
S = 7
Count = 0
Flag = 0
FirstRow = 7
SecondRow = 7
S_row = 7
 
ReDim Preserve ITSEerr(AvePeriod)
FirstTimestamp = CDbl(Sheets("MES").Cells(7, 1).Value)                              'сохранение начальной даты
    Do Until S > i - 1
        
        Sheets("ISE").Cells(S, 1 + 4 * LocalGroup) = Format(Sheets("MES").Cells(S, 1), "DD-MM-YYYY hh-mm-ss")                   'Перенос метки времени
        Sheets("ISE").Cells(S, 2 + 4 * LocalGroup) = (Sheets("MES").Cells(S, 5 + 4 * LocalGroup) - Sheets("MES").Cells(S, 6 + 4 * LocalGroup)) ^ 2         'Расчет ISE=(PV-SP)^2 по модулю
        
        If Sheets("MES").Cells(S, 7 + 4 * LocalGroup) = Sheets("MES").Cells(S + 1, 7 + 4 * LocalGroup) Then                     '   Сравнение смены режима MODE. Ложим в массив или за 10 минут или до смены режима
            Count = Count + 1
            ITSEerr(Count) = (Sheets("MES").Cells(S, 5 + 4 * LocalGroup) - Sheets("MES").Cells(S, 6 + 4 * LocalGroup)) ^ 2      '   сохранение в матрицу значение ошибки (PV-SP)^2
                                           
            Else
            Count = Count + 1
            ITSEerr(Count) = (Sheets("MES").Cells(S, 5 + 4 * LocalGroup) - Sheets("MES").Cells(S, 6 + 4 * LocalGroup)) ^ 2      '   сохранение в матрицу значение ошибки (PV-SP)^2
            Flag = 1
                                    
        End If
        SecondTimestamp = CDbl(Sheets("MES").Cells(S, 1).Value)                      'сохранение конечной даты
        
        Subcount = 1
        Sum = 0
        If Count = AvePeriod Or Flag = 1 Then
            SecondRow = S
            Do Until Subcount > Count
                Sum = Sum + (ITSEerr(Subcount - 1) + ITSEerr(Subcount)) / 2             ' Расчет суммы интеграла ошибок (метод трапеций) собраных за период (10 минут или до смены режима)
                Subcount = Subcount + 1
            Loop
            ITSE = Sum / Count
            ISE = Sum
            Sheets("ITSE").Cells(S_row, 2 + 4 * LocalGroup) = ITSE
            TimeStampITSE = Sheets("MES").Cells(SecondRow, 1).Value
            Sheets("ITSE").Cells(S_row, 1 + 4 * LocalGroup) = Format(TimeStampITSE, "DD-MM-YYYY hh-mm-ss")          'Вывод метки времени
            Count = 0
            S_row = S_row + 1
            Else
        End If
        
        Flag = 0
        S = S + 1
        FirstRow = SecondRow
        FirstTimestamp = SecondTimestamp
        Sum = 0
                
    Loop
End Sub
 
Sub ServiceFactor(LocalGroup As Integer)                   'Метрика по режимам регулятора
Dim Mode As Variant
Dim Var1, Var2, Var3, Var4, Var5, Var6, Var7, Var8, Var9, Var10, Var11, Var12, Var13, Var14, Var15, VarOther, VarAll As Long
            
            'Начальные значения переменных
Var1 = 0
Var2 = 0
Var3 = 0
Var4 = 0
Var5 = 0
Var6 = 0
Var7 = 0
Var8 = 0
Var9 = 0
Var10 = 0
Var11 = 0
Var12 = 0
Var13 = 0
Var14 = 0
Var15 = 0
VarOther = 0
VarAll = 0
S = 7           'Начальная строка данных
Mode = ""       'начальное обнуление переменной "Режим"
 
                'Копирование всех вариантов режимов с листа BasicSetUp, на лист ServiseFactor
Sheets("BasicSetUp").Range(Cells(3, 6).Address, Cells(17, 6).Address).Copy
Sheets("ServiceFactor").Cells(7, 1 + 4 * LocalGroup).PasteSpecial xlPasteValues
Sheets("ServiceFactor").Cells(22, 1 + 4 * LocalGroup).Value = "Other"
 
Do Until S > i - 1
            'Берем первое значение (с последующим перебором)
    Mode = Sheets("MES").Cells(S, 7 + 4 * LocalGroup).Value
            ' Сравнение с возможными значениями режимов
    If Mode = Sheets("BasicSetUp").Cells(3, 6).Value Then
    Var1 = Var1 + 1
    Else
        If Mode = Sheets("BasicSetUp").Cells(4, 6).Value Then
        Var2 = Var2 + 1
        Else
            If Mode = Sheets("BasicSetUp").Cells(5, 6).Value Then
            Var3 = Var3 + 1
            Else
                If Mode = Sheets("BasicSetUp").Cells(6, 6).Value Then
                Var4 = Var4 + 1
                Else
                    If Mode = Sheets("BasicSetUp").Cells(7, 6).Value Then
                    Var5 = Var5 + 1
                    Else
                        If Mode = Sheets("BasicSetUp").Cells(8, 6).Value Then
                        Var6 = Var6 + 1
                        Else
                            If Mode = Sheets("BasicSetUp").Cells(9, 6).Value Then
                            Var7 = Var7 + 1
                            Else
                                If Mode = Sheets("BasicSetUp").Cells(10, 6).Value Then
                                Var8 = Var8 + 1
                                Else
                                    If Mode = Sheets("BasicSetUp").Cells(11, 6).Value Then
                                    Var9 = Var9 + 1
                                    Else
                                        If Mode = Sheets("BasicSetUp").Cells(12, 6).Value Then
                                        Var10 = Var10 + 1
                                        Else
                                            If Mode = Sheets("BasicSetUp").Cells(13, 6).Value Then
                                            Var11 = Var11 + 1
                                            Else
                                                If Mode = Sheets("BasicSetUp").Cells(14, 6).Value Then
                                                Var12 = Var12 + 1
                                                Else
                                                    If Mode = Sheets("BasicSetUp").Cells(15, 6).Value Then
                                                    Var13 = Var13 + 1
                                                    Else
                                                        If Mode = Sheets("BasicSetUp").Cells(16, 6).Value Then
                                                        Var14 = Var14 + 1
                                                        Else
                                                            If Mode = Sheets("BasicSetUp").Cells(17, 6).Value Then
                                                            Var15 = Var15 + 1
                                                            Else
                                                                VarOther = VarOther + 1
                                                            End If
                                                        End If
                                                    End If
                                                End If
                                            End If
                                        End If
                                    End If
                                End If
                            End If
                        End If
                    End If
                End If
            End If
        End If
    End If
    S = S + 1                       'Инкримент строки
Loop
                                    ' Расчет Всего кол-ва данных
VarAll = Var1 + Var2 + Var3 + Var4 + Var5 + Var6 + Var7 + Var8 + Var9 + Var10 + Var11 + Var12 + Var13 + Var14 + Var15 + VarOther
                                    'Вывод полученных данных по группам
Sheets("ServiceFactor").Cells(14, 2 + 4 * LocalGroup).Value = VarAll
Sheets("ServiceFactor").Cells(7, 3 + 4 * LocalGroup).Value = Var1 / VarAll
Sheets("ServiceFactor").Cells(8, 3 + 4 * LocalGroup).Value = Var2 / VarAll
Sheets("ServiceFactor").Cells(9, 3 + 4 * LocalGroup).Value = Var3 / VarAll
Sheets("ServiceFactor").Cells(10, 3 + 4 * LocalGroup).Value = Var4 / VarAll
Sheets("ServiceFactor").Cells(11, 3 + 4 * LocalGroup).Value = Var5 / VarAll
Sheets("ServiceFactor").Cells(12, 3 + 4 * LocalGroup).Value = Var6 / VarAll
Sheets("ServiceFactor").Cells(13, 3 + 4 * LocalGroup).Value = Var7 / VarAll
Sheets("ServiceFactor").Cells(14, 3 + 4 * LocalGroup).Value = Var8 / VarAll
Sheets("ServiceFactor").Cells(15, 3 + 4 * LocalGroup).Value = Var9 / VarAll
Sheets("ServiceFactor").Cells(16, 3 + 4 * LocalGroup).Value = Var10 / VarAll
Sheets("ServiceFactor").Cells(17, 3 + 4 * LocalGroup).Value = Var11 / VarAll
Sheets("ServiceFactor").Cells(18, 3 + 4 * LocalGroup).Value = Var12 / VarAll
Sheets("ServiceFactor").Cells(19, 3 + 4 * LocalGroup).Value = Var13 / VarAll
Sheets("ServiceFactor").Cells(20, 3 + 4 * LocalGroup).Value = Var14 / VarAll
Sheets("ServiceFactor").Cells(21, 3 + 4 * LocalGroup).Value = Var15 / VarAll
Sheets("ServiceFactor").Cells(22, 3 + 4 * LocalGroup).Value = VarOther / VarAll
 
End Sub
 
Sub StdDevPV(LocalGroup As Integer)                     'Метрика Отклонения значения PV от среднего значения за период (10 минут)
 
Dim StdDevPVArr() As Variant                       'Массив на 10 минут
Dim TimeStamp, FirstTimestamp, SecondTimestamp As Double
Dim StdDev_PV As Double
                                                        
StdDev_PV = 0
 
S = 7
 
ReDim Preserve StdDevPVArr(AvePeriod)
 
Do Until S > (AvePeriod + 6)                                       'Берем первые 10 минут и заводим в массив
    StdDevPVArr(S - 6) = Sheets("MES").Cells(S, 5 + 4 * LocalGroup)
    S = S + 1
Loop
 
S = 7
H = 6
g = 0
Do Until S > i - 1
            
            Sheets("StdDevPV").Cells(S, 3 + 4 * LocalGroup).Formula = "=ABS(RC[-1])"    'вводим столбец с данными по модулю соседнего столбца справа
        
            InArr = 1
            Do Until InArr > AvePeriod                         'Считаем сумму значений в массиве
                
                Sum = Sum + StdDevPVArr(InArr)
                InArr = InArr + 1
                
            Loop
            
            StdDev_PV = Sheets("MES").Cells(S, 5 + 4 * LocalGroup) - Sum / 10   'Расчет Среднего значения из массива
            
            If g > AvePeriod Then                                                      'Переменная для массива StdDevArr(0-10)
            g = 0
            End If
            
            StdDevPVArr(g) = Sheets("MES").Cells(S + 1, 5 + 4 * LocalGroup)       'стираем самое старое значение и записываем новое (по кругу)
            H = H + 1
            S = S + 1
            g = g + 1
            Sum = 0
            Sheets("StdDevPV").Cells(S, 2 + 4 * LocalGroup) = StdDev_PV         'Вывод результатов на лист
            Sheets("StdDevPV").Cells(S, 1) = Format(Sheets("MES").Cells(S, 1), "DD-MM-YYYY hh-mm-ss")
                
Loop
 
End Sub
Sub StdDev(LocalGroup)                                  'Метрики StdDev и PercentStdDev
    
Dim StdDevArr() As Variant                       'Массив на 10 минут
Dim StdDev As Double
Dim StdDevPercent As Double
    
StdDev = 0
S = 7
    
ReDim Preserve StdDevArr(AvePeriod)
    
Do Until S > (AvePeriod + 6)                                       'Берем первые 10 минут и заводим в массив
    StdDevArr(S - 6) = Sheets("MES").Cells(S, 5 + 4 * LocalGroup)
    S = S + 1
Loop
    
S = 7
 
g = 1
    
Do Until S > i - 1
            InArr = 1
            Do Until InArr > AvePeriod                         'Считаем сумму значений в массиве
                
                Sum = Sum + StdDevArr(InArr)
                InArr = InArr + 1
                
            Loop
            
            StdDev = Sheets("MES").Cells(S, 6 + 4 * LocalGroup) - Sum / 10                                       'Расчет SP- Среднее значение из массива
            If Sheets("MES").Cells(S, 6 + 4 * LocalGroup) = 0 Then
            GoTo line01
            End If
            
            StdDevPercent = 100 - ((Sum / 10) * 100) / (Sheets("MES").Cells(S, 6 + 4 * LocalGroup))             'Расчет 100-((Среднее значение из массива*100)/SP)
line01:            If g > AvePeriod Then                                                      'Переменная для массива StdDevArr(0-10)
            g = 1
            End If
            
            StdDevArr(g) = Sheets("MES").Cells(S + 1, 5 + 4 * LocalGroup)       'стираем самое старое значение и записываем новое (по кругу)
 
            S = S + 1
            g = g + 1
            Sum = 0
            Sheets("StdDev").Cells(S, 2 + 4 * LocalGroup) = StdDev         'Вывод результатов на лист StdDev
            Sheets("StdDev").Cells(S, 1 + 4 * LocalGroup) = Format(Sheets("MES").Cells(S, 1), "DD-MM-YYYY hh-mm-ss")
            
            Sheets("PercentStdDev").Cells(S, 2 + 4 * LocalGroup) = StdDevPercent         'Вывод результатов на лист PercentStdDev
            Sheets("PercentStdDev").Cells(S, 1 + 4 * LocalGroup) = Format(Sheets("MES").Cells(S, 1), "DD-MM-YYYY hh-mm-ss")
 
Loop
 
End Sub
 
Sub PercentSaturation(LocalGroup As Integer)                        'Метрика процент положения выхода клапана
 
S = 7
D_10 = 0                                                            'Начальные значения по зонам 0-9, 10-19, 20-29, 30-39, 40-49, 50-59, 60-69, 70-79, 80-89, 90-100
D_20 = 0
D_30 = 0
D_40 = 0
D_50 = 0
D_60 = 0
D_70 = 0
D_80 = 0
D_90 = 0
D_100 = 0
D_all = 0
Do Until S > i - 1
    Mv_Value = Sheets("MES").Cells(S + 1, 8 + 4 * LocalGroup)
    If Mv_Value >= 0 And Mv_Value < 10 Then                     'сравнение и счет кол-ва значений в диапазоне 0-9%
        D_10 = D_10 + 1
    End If
    If Mv_Value >= 10 And Mv_Value < 20 Then                     'сравнение и счет кол-ва значений в диапазоне 10-19%
        D_20 = D_20 + 1
    End If
    If Mv_Value >= 20 And Mv_Value < 30 Then                     'сравнение и счет кол-ва значений в диапазоне 20-29%
        D_30 = D_30 + 1
    End If
    If Mv_Value >= 30 And Mv_Value < 40 Then                     'сравнение и счет кол-ва значений в диапазоне 30-39%
        D_40 = D_40 + 1
    End If
    If Mv_Value >= 40 And Mv_Value < 50 Then                     'сравнение и счет кол-ва значений в диапазоне 40-49%
        D_50 = D_50 + 1
    End If
    If Mv_Value >= 50 And Mv_Value < 60 Then                     'сравнение и счет кол-ва значений в диапазоне 50-59%
        D_60 = D_60 + 1
    End If
    If Mv_Value >= 60 And Mv_Value < 70 Then                     'сравнение и счет кол-ва значений в диапазоне 60-69%
        D_70 = D_70 + 1
    End If
    If Mv_Value >= 70 And Mv_Value < 80 Then                     'сравнение и счет кол-ва значений в диапазоне 70-79%
        D_80 = D_80 + 1
    End If
    If Mv_Value >= 80 And Mv_Value < 90 Then                     'сравнение и счет кол-ва значений в диапазоне 80-89%
        D_90 = D_90 + 1
    End If
    If Mv_Value >= 90 And Mv_Value <= 100 Then                     'сравнение и счет кол-ва значений в диапазоне 90-100%
        D_100 = D_100 + 1
    End If
    S = S + 1
    D_all = D_all + 1                                            'Счет общего кол-ва значений
Loop
 
Sheets("PercentSaturation").Cells(6, 1 + 4 * LocalGroup).Value = LocalGroup         'Вывод на лист процент значений по диапазонам (пример: "Кол-во значений в диапазоне 0-9" / "Общее кол-во значений")
Sheets("PercentSaturation").Cells(7, 1 + 4 * LocalGroup).Value = "10%"
Sheets("PercentSaturation").Cells(7, 2 + 4 * LocalGroup).Value = D_10 / D_all
Sheets("PercentSaturation").Cells(8, 1 + 4 * LocalGroup).Value = "20%"
Sheets("PercentSaturation").Cells(8, 2 + 4 * LocalGroup).Value = D_20 / D_all
Sheets("PercentSaturation").Cells(9, 1 + 4 * LocalGroup).Value = "30%"
Sheets("PercentSaturation").Cells(9, 2 + 4 * LocalGroup).Value = D_30 / D_all
Sheets("PercentSaturation").Cells(10, 1 + 4 * LocalGroup).Value = "40%"
Sheets("PercentSaturation").Cells(10, 2 + 4 * LocalGroup).Value = D_40 / D_all
Sheets("PercentSaturation").Cells(11, 1 + 4 * LocalGroup).Value = "50%"
Sheets("PercentSaturation").Cells(11, 2 + 4 * LocalGroup).Value = D_50 / D_all
Sheets("PercentSaturation").Cells(12, 1 + 4 * LocalGroup).Value = "60%"
Sheets("PercentSaturation").Cells(12, 2 + 4 * LocalGroup).Value = D_60 / D_all
Sheets("PercentSaturation").Cells(13, 1 + 4 * LocalGroup).Value = "70%"
Sheets("PercentSaturation").Cells(13, 2 + 4 * LocalGroup).Value = D_70 / D_all
Sheets("PercentSaturation").Cells(14, 1 + 4 * LocalGroup).Value = "80%"
Sheets("PercentSaturation").Cells(14, 2 + 4 * LocalGroup).Value = D_80 / D_all
Sheets("PercentSaturation").Cells(15, 1 + 4 * LocalGroup).Value = "90%"
Sheets("PercentSaturation").Cells(15, 2 + 4 * LocalGroup).Value = D_90 / D_all
Sheets("PercentSaturation").Cells(16, 1 + 4 * LocalGroup).Value = "100%"
Sheets("PercentSaturation").Cells(16, 2 + 4 * LocalGroup).Value = D_100 / D_all
End Sub

shanemac51 · 17.06.2021, 14:42

Сообщение от Gilza1983

Долго выполняется.

насколько долго - минута, пять, тридцать, час, еще больше
сколько примерно строк в больших таблицах

трудно оценить без примера таблиц, слишком много циклов(например месяц) - видимо можно считать его в массив и искать в массиве

@Gilza1983 · 17.06.2021, 15:05 **[ТС]**

shanemac51,
Кол-во строк в исходных таблицах зависит от периода выгрузки данных и дискретности (задаваемая величина).
Файл во вложении.

@Burk · 17.06.2021, 15:59

Gilza1983,

Visual Basic
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
'У вас
Sheets("StdDev").Select
Range("A7:CC90000").Select
Selection.ClearContents
'не используйте так часто Select
'вместо этого и в остальных аналогичных местах
Sheets("StdDev").Range ("A7:CC90000")
'можно это сделать и в цикле, если по листам идти с их номерами.
'в Sub ServiceFactor
'при объвлении переменных в ВБА тип надо указывать, если есть нужда, для
'каждой переменной, иначе у ваших ВАРов Long будет только у последней
'При объявлении переменных им присваиватся пустое значение, поэтому
'после объявления можно не писать многочисленные А=0
' и думаю, что Var надо сделать массивом, тогда вместо длиннющей цепочки
'If ... Then ... Else можно будет воспользоваться циклом,к примеру
For J = 1 To 15
  If Mode = Sheets("BasicSetUp").Cells(J + 2, 6).Value Then
    Var(J) = Var(J) + 1: Exit For
  End If
Next
'Программа будет более читабельна. И дальше аналогично вместо
Sheets("ServiceFactor").Cells(7, 3 + 4 * LocalGroup).Value = Var1 / VarAll
Sheets("ServiceFactor").Cells(8, 3 + 4 * LocalGroup).Value = Var2 / VarAll
'тоже можно сделать циклом
'Это не даст большого выигрыша по времени, но всё-таки
'Если у вас есть где-то поиск определенного значения, то подскажите
'в каком макросе, чтобы самому не рыться. На поиске можно экономить время
'Завтра ещё гляну

shanemac51 · 17.06.2021, 16:16

Сообщение от Gilza1983

Do Until S > i - 1
'Берем первое значение (с последующим перебором)
Mode = Sheets("MES").Cells(S, 7 + 4 * LocalGroup).Value
' Сравнение с возможными значениями режимов
If Mode = Sheets("BasicSetUp").Cells(3, 6).Value Then
Var1 = Var1 + 1
Else

обращение к Sheets("BasicSetUp") не зависит от параметров цикла

Добавлено через 5 минут
а здесь еще и более 20 сравнений, хотя может в первом уже сравнилось

Visual Basic
1
2
3
4
5
6
7
8
Do Until S > i - 1
    Mv_Value = Sheets("MES").Cells(S + 1, 8 + 4 * LocalGroup)
    If Mv_Value >= 0 And Mv_Value < 10 Then                     'сравнение и счет кол-ва значений в диапазоне 0-9%
        D_10 = D_10 + 1
    End If
    If Mv_Value >= 10 And Mv_Value < 20 Then                     'сравнение и счет кол-ва значений в диапазоне 10-19%
        D_20 = D_20 + 1
    End If

@Gilza1983 · 17.06.2021, 16:26 **[ТС]**

shanemac51,

обращение к Sheets("BasicSetUp") не зависит от параметров цикла

Да, но не теряет смысла.
В данном блоке берется массив данных из листа "MES", сравнивается с введенными данными из листа "BasicSetup" и считается кол-во совпадений.
Т.е. пользователь задает перечень возможных режимов, а часть макроса считает сколько таких значений в выгрузке.

а здесь еще и более 20 сравнений, хотя может в первом уже сравнилось

Нет, не сравнивалось. Там используются другие столбцы массива данных.
Тут есть некий массив данных в диапазоне от 0% до 100%. Необходимо посчитать сколько значений находилось в разных диапазонах (0%-10%, 11%-20% и т.д. до 91%-100%).

shanemac51 · 17.06.2021, 16:37

Сообщение от Gilza1983

Тут есть некий массив данных в диапазоне от 0% до 100%

если значение попало в диапазон 10-20, нет смысла сравнивать его с 30-30,30-40,,,,,,и т.д

при сравнении с Sheets("BasicSetUp") вы обходите повторные сравнения, а во втором цикле не обходите

циклы у вас прописаны по разному

@Gilza1983 · 17.06.2021, 16:41 **[ТС]**

shanemac51,

если значение попало в диапазон 10-20, нет смысла сравнивать его с 30-30,30-40,,,,,,и т.д

Да, по времени, оптимизируется. Но количество условий не измениться, если я их буду делать встроеными друг в друга (через Else).

@Burk · 17.06.2021, 16:42

В 7 строке .ClearContents

shanemac51 · 17.06.2021, 17:58

Сообщение от Gilza1983

Но количество условий не измениться

изменится, если код будет немного иной

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
Do Until S > i - 1
    Mv_Value = Sheets("MES").Cells(S + 1, 8 + 4 * LocalGroup)
If Mv_Value <0 then
' .....какое -то действие или пусто
elseif Mv_Value <10 then
        D_10 = D_10 + 1
elseif Mv_Value <20 then  
        D_20 = D_20 + 1
 elseif Mv_Value <30 then                    
        D_30 = D_30 + 1
''''''и так до 100
    End If   'только 1

@Alex77755 · 20.06.2021, 09:51

Сообщение от Gilza1983

Visual Basic
1
2
StdDev = Sheets("MES").Cells(S, 6 + 4 * LocalGroup) - Sum / 10                                       'Расчет SP- Среднее значение из массива
            If Sheets("MES").Cells(S, 6 + 4 * LocalGroup) = 0 Then

Обращение к ячейкам раз в 30-40 медленнее чем работа с массивами

@Gilza1983 · 21.06.2021, 15:25 **[ТС]**

Сообщение от Alex77755

Обращение к ячейкам раз в 30-40 медленнее чем работа с массивами

Alex77755,
Но считать с ячеек в массив и потом записать в ячейки, тоже время...
Тем более размер массива заранее неизвестен (кол-во столбцов и строк задаётся в листе "BasicSetup").

@Alex77755 · 21.06.2021, 18:31

В любом случае работа с массивами значительно быстрей

@Burk · 21.06.2021, 20:03

Gilza1983, надо просто заблокировать обновление экрана. Посмотрите мой макрос обновления диаграмм. Я сам макрос малость усовершенствовал, стал покороче.
Без блокировки обновления экрана на моем компе 265 секунд, с блокировкой 15 секунд. В других макросах, видимо, надо сделать аналогично.

Кликните здесь для просмотра всего текста

Visual Basic
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
Sub UpdateDiadramm_Click()                                  'Процедура обновления диаграмм
Dim lRow As Long, lCol As Long '!!!                 Сделать в шапку период данных
Dim ColSer As Long, StRow As Long, StCol As Long
Dim Temp As Variant, I As Integer, J As Integer, K As Integer, ArSh
Application.ScreenUpdating = False 'Закомментировать, если хотите сравнить времена
tim = Timer
Sheets("DiagTemp").Cells.ClearContents                      'Очищаем лист данных для диаграмм
DiagGroup = Sheets("Diagramms").Cells(2, 3).Value           'Считываем введенную группу тега
StRow = 3                                                   ' Задаем / расчитываем начальные и конечные ячейки для копирования диапазоном
StCol = 2 + 4 * DiagGroup
lCol = StCol + 3
lRow = Sheets("MES").Cells(1, 8).Value
ColSer = 3 + 4 * DiagGroup
ArSh = Array("StdDevPV", "IAE", "ITAE", "ISE", "ITSE", "PercentSaturation", "StdDev", "PercentStdDev")
K = 0
For I = 0 To UBound(ArSh)
  J = IIf(I = 0, 2, 3 * (I + 1))
  Sheets("DiagTemp").Cells(1, J).Value = ArSh(I)
  With Sheets(ArSh(I))
    .Range(.Cells(StRow, StCol - K), .Cells(lRow, lCol - K)).Copy _
    Destination:=Sheets("DiagTemp").Cells(3, J)
  End With
  K = 1
Next
With Sheets("ServiceFactor")
  Sheets("DiagTemp").Cells(1, 18).Value = "ServiceFactor"
  .Range(.Cells(7, 1), .Cells(22, 1)).Copy _
  Destination:=Sheets("DiagTemp").Cells(3, 18)
  .Range(.Cells(7, ColSer), .Cells(22, ColSer)).Copy _
  Destination:=Sheets("DiagTemp").Cells(3, 19)
End With
Worksheets("DiagTemp").Calculate                                'Вычисление листов DiagTemp и Diagramms
Worksheets("Diagramms").Calculate
Application.ScreenUpdating = True
MsgBox Timer - tim
 
End Sub

@Burk · 22.06.2021, 06:07

Gilza1983, в макросе у меня ошибка, после строки 17 надо вставить If I > 4 Then J = J + 3

@Hugo121 · 22.06.2021, 11:48

Помнится был вопрос как ускорить макрос, выполнявшийся 40 минут. Замена перебора ячеек на перебор массива дала выигрыш 39 минут 55 секунд.
Если бы добавить туда ещё использование словаря - возможно было бы ещё в пару раз быстрее, но тогда я ещё не знал словарей

@Burk · 22.06.2021, 11:59

Hugo121, в макросе построения диаграмм львиную долю времени занимает копирование Огромного количества ненужных пока ячеек (а вдруг когда-нибудь потребуется) в лист с временными данными. И никаких переборов в этом макросе нет.

@Hugo121 · 22.06.2021, 12:15

Burk, я не про диаграммы, я скорее про

Сообщение от Gilza1983

Но считать с ячеек в массив и потом записать в ячейки, тоже время...

Новые блоги и статьи Все статьи Все блоги /
Новый ноутбук volvo 07.12.2025 Всем привет. По скидке в "черную пятницу" взял себе новый ноутбук Lenovo ThinkBook 16 G7 на Амазоне: Ryzen 5 7533HS 64 Gb DDR5 1Tb NVMe 16" Full HD Display Win11 Pro	Музыка, написанная Искусственным Интеллектом volvo 04.12.2025 Всем привет. Некоторое время назад меня заинтересовало, что уже умеет ИИ в плане написания музыки для песен, и, собственно, исполнения этих самых песен. Стихов у нас много, уже вышли 4 книги, еще 3. . .	От async/await к виртуальным потокам в Python IndentationError 23.11.2025 Армин Ронахер поставил под сомнение async/ await. Создатель Flask заявляет: цветные функции - провал, виртуальные потоки - решение. Не threading-динозавры, а новое поколение лёгких потоков. Откат?. . .	Поиск "дружественных имён" СОМ портов Argus19 22.11.2025 Поиск "дружественных имён" СОМ портов На странице: https:/ / norseev. ru/ 2018/ 01/ 04/ comportlist_windows/ нашёл схожую тему. Там приведён код на С++, который показывает только имена СОМ портов, типа,. . .	Сколько Государство потратило денег на меня, обеспечивая инсулином. Programma_Boinc 20.11.2025 Сколько Государство потратило денег на меня, обеспечивая инсулином. Вот решила сделать интересный приблизительный подсчет, сколько государство потратило на меня денег на покупку инсулинов. . . .
Ломающие изменения в C#.NStar Alpha Etyuhibosecyu 20.11.2025 Уже можно не только тестировать, но и пользоваться C#. NStar - писать оконные приложения, содержащие надписи, кнопки, текстовые поля и даже изображения, например, моя игра "Три в ряд" написана на этом. . .	Мысли в слух kumehtar 18.11.2025 Кстати, совсем недавно имел разговор на тему медитаций с людьми. И обнаружил, что они вообще не понимают что такое медитация и зачем она нужна. Самые базовые вещи. Для них это - когда просто люди. . .	Создание Single Page Application на фреймах krapotkin 16.11.2025 Статья исключительно для начинающих. Подходы оригинальностью не блещут. В век Веб все очень привыкли к дизайну Single-Page-Application . Быстренько разберем подход "на фреймах". Мы делаем одну. . .	Фото: Daniel Greenwood kumehtar 13.11.2025	Расскажи мне о Мире, бродяга kumehtar 12.11.2025 — Расскажи мне о Мире, бродяга, Ты же видел моря и метели. Как сменялись короны и стяги, Как эпохи стрелою летели. - Этот мир — это крылья и горы, Снег и пламя, любовь и тревоги, И бескрайние. . .

@Burk 1847 / 1162 / 354 Регистрация: 11.07.2014 Сообщений: 4,107
	17.06.2021, 16:42
	В 7 строке .ClearContents 0

@Alex77755 11525 / 3812 / 683 Регистрация: 13.02.2009 Сообщений: 11,229
	21.06.2021, 18:31
	В любом случае работа с массивами значительно быстрей 0

@Burk 1847 / 1162 / 354 Регистрация: 11.07.2014 Сообщений: 4,107
	22.06.2021, 06:07
	Gilza1983, в макросе у меня ошибка, после строки 17 надо вставить If I > 4 Then J = J + 3 0

@Hugo121 6997 / 2895 / 555 Регистрация: 19.10.2012 Сообщений: 8,803
	22.06.2021, 11:48
	Помнится был вопрос как ускорить макрос, выполнявшийся 40 минут. Замена перебора ячеек на перебор массива дала выигрыш 39 минут 55 секунд. Если бы добавить туда ещё использование словаря - возможно было бы ещё в пару раз быстрее, но тогда я ещё не знал словарей 1

@Burk 1847 / 1162 / 354 Регистрация: 11.07.2014 Сообщений: 4,107
	22.06.2021, 11:59
	Hugo121, в макросе построения диаграмм львиную долю времени занимает копирование Огромного количества ненужных пока ячеек (а вдруг когда-нибудь потребуется) в лист с временными данными. И никаких переборов в этом макросе нет. 0