Question

我是新手，刚刚开始使用VBA。我有以下代码适用于我正在做的事情，但由于我的范围已经变为800行，因此执行起来非常慢。我希望有人可以建议进行更改以使其运行更快。

我有我的摘要表，我从其他几个标签中预先填充了A列和C列的值，然后运行以下宏来隐藏空行，基于B列除了空白之外还有任何值。

我只希望在摘要选项卡上显示具有相关系统的选项卡，因此我使用基于摘要表单元格中的公式的“E”限定符，因此它隐藏了不需要的系统。

所以我的循环发生两次，一次是空白行，第二次是隐藏不需要的系统。

感谢大家的代码/评论。但是，我正在重新思考这个项目，并希望您对以下是否是更好的方法有所了解。首先，我想要完成的事情：我正在尝试生成一个仅显示用户希望在其提案中包含的系统的提案。每个选项卡都是系统的单独估计。我有一个项目信息选项卡，列出用户选择Y或N的每个系统，仅包括他想要估计的系统，允许用户选择是否要包含系统。因此，我在摘要选项卡上有一个按钮，它只应从项目信息选项卡中拉出标记为“Y”的系统，转到该选项卡，拉出数量> 0的行，并在摘要选项卡上列出它们显示每个系统的物料清单。

所以我认为更好的方法是，检查Y或Y，然后转到该系统选项卡，对行进行排序，以便只有第2列＆gt; 0的行是过滤器的结果，然后将这些行复制到“摘要”选项卡，然后使用“Y”转到下一个选项卡。

这是生成此摘要标签的更好方法吗？

Sub Summary_BOM()
'
' Hide Empty Rows Macro

Rows("72:808").Select
    Selection.EntireRow.Hidden = False

    BeginRow = 72
    EndRow = 808
    ChkCol = 2

    For RowCnt = BeginRow To EndRow
        If Cells(RowCnt, ChkCol).Value < 1 Then
           Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
    Next RowCnt

' RemoveUnusedSystems Macro
'
    Rows("72:808").Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.EntireRow.Hidden = False

    BeginRow = 72
    EndRow = 808
    ChkCol = 5

    For RowCnt = BeginRow To EndRow
        If Cells(RowCnt, ChkCol).Value = "E" Then
            Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
    Next RowCnt

    Application.ScreenUpdating = True
    Range("A71").Select

    MsgBox ("   Systems and BOM Update Complete!   ")

End Sub

Answer 1

请考虑使用以下脚本满足您的要求：

Sub Summary_BOM()
'
' Hide Empty Rows Macro

    Application.ScreenUpdating = False

    Dim rng As Range
    Set rng = ActiveSheet.Range("B72:B808")

    Dim cell As Range

    For Each cell In rng.Cells
        If cell.Value2 = "" Or cell.Offset(0, 3).Value2 = "E" Then
            cell.EntireRow.Hidden = True
        Else
            cell.EntireRow.Hidden = False
        End If
    Next cell

    Application.ScreenUpdating = True
    MsgBox ("   Systems and BOM Update Complete!   ")

End Sub

该脚本有望提高效率，因为您只需要进行1次循环并同时评估这两种情况。它也没有使用.Select，这往往会减慢脚本速度。您可以使用And或Or以及ElseIf向其中添加更多条件。的问候，

编辑：根据Marco Getrost的非常有效的指示，我已经更改了If语句的第二个条件，以评估循环单元格右侧的3列。

Answer 2

试试这个：

Sub test()

Application.ScreenUpdating = False

Dim BeginRow As Long, EndRow As Long, c As Long

BeginRow = 72
EndRow = 808

With ActiveSheet

For c = BeginRow To EndRow

If .Cells(c, 2).Value < 1 Or .Cells(c, 5).Value = "E" Then

    .Rows(c).EntireRow.Hidden = True

End If

Next

End With

MsgBox "complete"

Application.ScreenUpdating = True

End Sub

快速将非空行复制到新选项卡

2 个答案: