循环遍历列表并隐藏空白答案

【问题标题】：Loop through list and hide blanks循环遍历列表并隐藏空白
【发布时间】：2016-12-27 00:05:46
【问题描述】：

我在一个选项卡上有一个名为“地区列表”的列表，还有一个通过将地区名称放入单元格 C3 来驱动的模板。每个地区都有大量不同的分支机构（1 到 500 多个分支机构之间，具体取决于地区），因此报告模板在某些情况下有很多空白区域。我想出这个循环遍历地区列表，复制模板选项卡，将其重命名为地区名称，将地区名称插入单元格 C3，然后我有另一个循环来隐藏空白行。

它可以工作，但它需要很长时间，例如每个选项卡 5 分钟，然后在大约四个选项卡之后，我在第一个类似 Sub CreateTabsFromList 时遇到对象错误。

代码是否有问题，或者这只是一种非常低效的方法？如果是这样，任何人都可以提供更好的方法吗？

Sub HideRows()
Dim r As Range, c As Range
Set r = Range("a1:a1000") 'Sets range well beyond the last possible row with data
Application.ScreenUpdating = False
For Each c In r
If Len(c.Text) = 0 Then
    c.EntireRow.Hidden = True  'Hide the row if the cell in A is blank
Else
    c.EntireRow.Hidden = False
End If
Next c
Application.ScreenUpdating = True
End Sub


Sub CreateSheetsFromAList()
Dim MyCell As Range, MyRange As Range

Set MyRange = Sheets("District List").Range("A1")
Set MyRange = Range(MyRange, MyRange.End(xlDown))

For Each MyCell In MyRange
   Sheets("Template").Copy After:=Sheets(Sheets.Count) 'creates a new worksheet
    Range("C3").Value = MyCell.Value 'Pastes value in C3
    Sheets(Sheets.Count).Name = MyCell.Value 'renames worksheet
    HideRows 'Hides rows where cell in column A is ""


Next MyCell

结束子

【问题讨论】：

你从来没有标记任何答案？您的问题从未得到有效答案，或者您只是不知道该怎么做？
我猜你是在问我以前的一篇帖子，我刚刚回去并标记了一个答案。对于这个我几分钟前刚刚发布的，还没有得到答案。

标签： vba loops for-loop foreach

【解决方案1】：

删除/隐藏行，1 by 1 是最慢的方法。始终将它们放在一个范围内并一次性删除/隐藏它们，循环单元格也比循环数组慢。

Sub HideRows()

    Dim lCtr    As Long
    Dim rngDel  As Range
    Dim r       As Range
    Dim arr

    Set r = Range("a1:a1000") 'Sets range well beyond the last possible row with data
    Application.ScreenUpdating = False

    arr = r
    For lCtr = LBound(arr) To UBound(arr)
        If arr(lCtr, 1) = "" Then
            If rngDel Is Nothing Then
                Set rngDel = Cells(lCtr, 1) 'harcoded 1 as you are using column A
             Else
                Set rngDel = Union(rngDel, Cells(lCtr, 1))
            End If
        End If
    Next


    If Not rngDel Is Nothing Then
        rngDel.EntireRow.Hidden=True
    End If

    Application.ScreenUpdating = True
End Sub

1000 行只需要几分之一秒。

【讨论】：