Код VBA - пропустить некоторые части, если некоторые другие исключены

ProgramBox

Код VBA — пропустить некоторые части, если некоторые другие исключены

Post author:admin
Запись опубликована:9 марта, 2023
Post category:Вопросы по программированию

#vba #performance #excel #lag

#vba #Производительность #excel #задержка

Вопрос:

Я написал этот фрагмент кода, но убрал дополнительный заполнитель между ними. В зависимости от выбранных временных точек, он скроет соответствующие строки.

Контейнер 1 всегда будет заполнен, однако, если другой контейнер не выбран, я хочу, чтобы он скрывал все оставшиеся строки без обработки остальной части кода. Поэтому, если выбраны контейнеры 1 и 2, он запустит код для них, не запуская остальную часть кода.

Переписывание этого в виде цикла было бы невероятно сложным, поскольку существует так много возможных временных точек, что это скорее проблема пропуска кода, который не имеет отношения к делу. Почти как строка перехода или что-то в этом роде? Я не знаю!

Есть ли какой-либо другой способ сделать этот код более эффективным, чем временное отключение прерываний отображения, обновления экрана и событий включения? На странице не выполняется вычисление, скрывается только строка.

Например, если Q26 пуст (нет контейнера 2) Я хочу, чтобы он дошел до конца кода, не обрабатывая ничего другого, кроме того, как я его написал, он все равно обрабатывает остальную часть кода.

Спасибо за вашу помощь

 If Worksheets("StabDataCapture").Range("q26").Value = "" Then Worksheets("Template").Rows("142:1048576").EntireRow.Hidden = True Else

Спасибо за помощь!

 Sub Containers()

Dim xPctComp As Integer

Application.StatusBar = "Container 1: " amp; _
  Format(xPctComp, "##0%")

ActiveSheet.DisplayPageBreaks = False
Application.EnableEvents = False
Application.ScreenUpdating = False



'CONTAINER 1 ROW HIDES

'@@@@@@@@@@@@@@@@@@@@@@@@@@@ 60°C @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

'Show/Hide 1@60

    If Worksheets("StabDataCapture").Range("B33").Value = "" Then
        Worksheets("Template").Rows("8:8").EntireRow.Hidden = True
    End If

Application.StatusBar = "Container 2: " amp; _
  Format(xPctComp, "##25%")

If Worksheets("StabDataCapture").Range("q26").Value = "" Then Worksheets("Template").Rows("142:1048576").EntireRow.Hidden = True Else

'CONTAINER 2 ROW HIDES

'@@@@@@@@@@@@@@@@@@@@@@@@@@@ 60°C @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

'Show/Hide 1@60

    If Worksheets("StabDataCapture").Range("P33").Value = "" Then
                Worksheets("Template").Rows("146:146").EntireRow.Hidden = True
    End If

Application.StatusBar = "Container 3: " amp; _
  Format(xPctComp, "##50%")

'CONTAINER 3 ROW HIDES

 If Worksheets("StabDataCapture").Range("c91").Value = "" Then Worksheets("Template").Rows("280:1048576").EntireRow.Hidden = True Else

'@@@@@@@@@@@@@@@@@@@@@@@@@@@ 60°C @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

'Show/Hide 1@60

    If Worksheets("StabDataCapture").Range("B98").Value = "" Then
        Worksheets("Template").Rows("284:284").EntireRow.Hidden = True
    End If
Application.StatusBar = "Container 4: " amp; _
  Format(xPctComp, "##75%")

 If Worksheets("StabDataCapture").Range("q91").Value = "" Then Worksheets("Template").Rows("418:1048576").EntireRow.Hidden = True Else


'@@@@@@@@@@@@@@@@@@@@@@@@@@@ 60°C @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

'Show/Hide 1@60

    If Worksheets("StabDataCapture").Range("P98").Value = "" Then
                Worksheets("Template").Rows("422:422").EntireRow.Hidden = True
    End If

Application.EnableEvents = True
Application.ScreenUpdating = True
Application.StatusBar = ""

End Sub

1. Вы могли бы попробовать использовать GoTo , но это не очень рекомендуется… Или просто измените свой код с большей логикой! Цикл не требуется, но с If помощью s или Select s и правильного отступа вы можете это сделать

2. Использование локальных переменных, например, w = Worksheets («StabDataCapture») и последующее обращение к ним (или с блоками) может обеспечить очень небольшое улучшение (настолько малое, что оно будет учитываться только в том случае, если эта функция вызывается для каждого изменения выбранной ячейки). Я бы тоже попробовал приложение. Вычисление = xlManual, даже если вы думаете, что вычислений не так много. Однако я не понимаю, почему ваш код должен быть медленным. И, как также отметил R3uK, этот отступ ужасен.

3. Если вы также вызываете эту функцию из другого, Сохраните значение DisplayPageBreaks , EnableEvents и т. Д. И восстановите его до исходного в конце. В противном случае вызывающий этот подраздел может потерять эти оптимизации, если он также их использовал.

Ответ №1:

Вам нужна процедура для повторной активации экрана и событий,

 Sub Restart_Screen()
With Application
    .EnableEvents = True
    .ScreenUpdating = True
    .StatusBar = vbNullString
End With
End Sub

При использовании Exit Sub это может выглядеть так :

 Sub test_vividillusion()
Dim xPctComp As Integer
Dim wS As Worksheet
Dim wsT As Worksheet
Set wS = Sheets("StabDataCapture")
Set wsT = Sheets("Template")

With Application
    .EnableEvents = False
    .ScreenUpdating = False
    .StatusBar = "Container 1: " amp; Format(xPctComp, "##0%")
End With
ActiveSheet.DisplayPageBreaks = False

'CONTAINER 1 ROW HIDES
'@@@@@@@@@@@@@@@@@@@@@@@@@@@ 60°C @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'Show/Hide 1@60
If wS.Range("B33").Value = vbNullString Then wsT.Rows("8:8").EntireRow.Hidden = True
Application.StatusBar = "Container 2: " amp; Format(xPctComp, "##25%")

If wS.Range("q26").Value = vbNullString Then
    wsT.Rows("142:1048576").EntireRow.Hidden = True
    Restart_Screen
    Exit Sub
Else
End If

'CONTAINER 2 ROW HIDES
'@@@@@@@@@@@@@@@@@@@@@@@@@@@ 60°C @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'Show/Hide 1@60
If wS.Range("P33").Value = vbNullString Then wsT.Rows("146:146").EntireRow.Hidden = True
Application.StatusBar = "Container 3: " amp; Format(xPctComp, "##50%")

If wS.Range("c91").Value = vbNullString Then
    wsT.Rows("280:1048576").EntireRow.Hidden = True
    Restart_Screen
    Exit Sub
Else
End If
'CONTAINER 3 ROW HIDES
'@@@@@@@@@@@@@@@@@@@@@@@@@@@ 60°C @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'Show/Hide 1@60
If wS.Range("B98").Value = vbNullString Then wsT.Rows("284:284").EntireRow.Hidden = True
Application.StatusBar = "Container 4: " amp; Format(xPctComp, "##75%")

If wS.Range("q91").Value = vbNullString Then
    wsT.Rows("418:1048576").EntireRow.Hidden = True
    Restart_Screen
    Exit Sub
Else
End If

'@@@@@@@@@@@@@@@@@@@@@@@@@@@ 60°C @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'Show/Hide 1@60
If wS.Range("P98").Value = vbNullString Then wsT.Rows("422:422").EntireRow.Hidden = True
Restart_Screen
End Sub

1. Это работает фантастически хорошо, однако для обновления потребуется более 400 строк кода, и даже с поиском и заменой мне потребуется целый день. Я обязательно буду использовать это в будущих реализациях. Я разбил его на модули, и эта единственная строка кода (x3) — это то, как я решил проблему. Спасибо за вашу помощь!!

2. Если рабочие листы («StabDataCapture»). Диапазон («q26»).Значение <> 0 Затем Контейнер2 Еще рабочие листы («Шаблон»). Строки («142: 1048576»).Весь поток. Скрыто = True