Question

我在一个标签上有一个名为“区列表”的列表，以及通过将区域名称放入单元格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

End Sub

Answer 1

删除/隐藏行，1比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行中只需要几分之一秒。

循环列表并隐藏空格

1 个答案: