遍历列表并隐藏空白

我在一个选项卡上有一个名为“区域列表”的列表和一个将区域名称放入单元格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

结束子

来源

2016-08-19 AngelOfDef

你从不标记任何答案？你从来没有得到一个有效的答案你的问题，或者你只是不知道该怎么做？ – cyboashu

我猜你在问我关于我的一篇旧帖子，我刚才回去并给出了答案。对于我刚刚发布的这个，几分钟前还没有得到答案。 – AngelOfDef

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

来源

2016-08-19 18:55:04 cyboashu

遍历列表并隐藏空白

回答

相关问题