☰

将我的宏转换为数组？

tag-icon • tag-icon macros microsoft-excel-2016
将我的宏转换为数组？

我编写了一个宏代码，可以显示包含单词“逾期”的行，并隐藏包含单词（已完成、待处理、进行中、延迟）的其他行。一切进展顺利，但宏需要 2 分钟才能工作，而数据库仍然是空的。我读到数组可以解决这个问题，并使宏工作得非常快。我试图将我的代码转换为数组，但没有成功。

仅供您参考，对我来说第一行是（18），列是（Q），所以 Q18 包含第一个数据。

Sub Overdue()
On Error Resume Next

Application.ScreenUpdating = False

Worksheets("Dashboard-Data").Rows.EntireRow.Hidden = False
ltrw = Cells(Rows.Count, "Q").End(xlUp).Row

For i = 2 To ltrw
 
 
 If Cells(i, 17).Value = "Overdue" Then
    Cells(i, 1).EntireRow.Hidden = False
   
    ElseIf Cells(i, 17).Value = "Pending" Then
    Cells(i, 1).EntireRow.Hidden = True
   
    ElseIf Cells(i, 17).Value = "In Progress" Then
    Cells(i, 1).EntireRow.Hidden = True
   
    ElseIf Cells(i, 17).Value = "Completed" Then
    Cells(i, 1).EntireRow.Hidden = True
   
    ElseIf Cells(i, 17).Value = "Delayed" Then
    Cells(i, 1).EntireRow.Hidden = True
       
     ElseIf Cells(i, 17).Value = "Delayed & Overdue" Then
    Cells(i, 1).EntireRow.Hidden = True
   
    Else
   
    Cells.EntireRow.Hidden = False
     
         End If
      Next i


Application.ScreenUpdating = True
End Sub

答案1

首先，你可以显著缩短宏代码：

Sub Overdue2()
Dim ltrw As Long, i As Long
On Error Resume Next
    
    Application.ScreenUpdating = False
    Worksheets("Dashboard-Data").Rows.EntireRow.Hidden = False
    ltrw = Cells(Rows.Count, "Q").End(xlUp).Row
    
    For i = 2 To ltrw
        Cells(i, 1).EntireRow.Hidden = (Cells(i, 17).Value <> "Overdue")
    Next i
    Application.ScreenUpdating = True
End Sub

因此，程序不需要评估 If-Then-ElseIf-Then... 中的所有多个条件。这会稍微（相当多）加快宏的速度。

不确定你使用数组的想法是否能大大改善算法。我建议使用内置的 Excel 过滤机制 - 代码会很短而且足够快：

Sub Overdue3()
Dim ltrw As Long
On Error Resume Next
    Worksheets("Dashboard-Data").Rows.EntireRow.Hidden = False
    ltrw = Cells(Rows.Count, "Q").End(xlUp).Row
    Worksheets("Dashboard-Data").Range("Q17:Q" & ltrw).AutoFilter Field:=1, Criteria1:="Overdue"
End Sub

如果您不想看到自动过滤图标，您可以像这样更改代码：

Sub Overdue4()
Dim ws As Worksheet
Dim ltrw As Long, i As Long
Dim filteredRange As Range, filteredRows As Range
On Error Resume Next
    Set ws = Worksheets("Dashboard-Data")
    ws.Rows.EntireRow.Hidden = False
    ltrw = ws.Cells(Rows.Count, "Q").End(xlUp).Row
    Set filteredRange = ws.Range("Q17:Q" & ltrw)
    filteredRange.AutoFilter Field:=1, Criteria1:="Overdue"
Rem Now let's store in the filteredRows variable the rows that remained visible
    Set filteredRows = filteredRange.SpecialCells(xlCellTypeVisible).Rows
Rem Disable AutoFilter
    filteredRange.AutoFilter
Rem Hide all rows in filteredRange
    filteredRange.Rows.EntireRow.Hidden = True
Rem and unhide the rows that are remembered in the variable
    filteredRows.Rows.EntireRow.Hidden = False
End Sub

相关内容