VBA代码 - 如果有其他部分被删除,请跳过某些部分

时间:2016-10-11 08:15:38

标签: excel vba performance excel-vba lag

我已经编写了这段代码,但却在其间插入了额外的填充物。根据所选的时间点,它将隐藏相应的行。

容器1将始终被填充,但是,如果未选择另一个容器,我希望它隐藏所有剩余的行而不处理其余代码。因此,如果选择了容器1和容器2,它将运行这些代码而不运行其余代码。

重写这个循环会非常复杂,因为有太多可能的时间点,更多的是跳过不相关的代码的问题。几乎像一个转到线或什么?我不知道!

除了临时禁用DisplayPageBreaks,ScreenUpdating和启用事件之外,还有其他方法可以使此代码更有效地运行吗?页面上没有执行任何计算,只有行隐藏。

例如,如果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: " & _
  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: " & _
  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: " & _
  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: " & _
  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 个答案:

答案 0 :(得分: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: " & 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: " & 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: " & 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: " & 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