主页 / computer / 问题 / 1783310
Accepted
MaRaM Alhashlamoun
Asked: 2023-05-10 12:45:59 +0800 CST

将我的宏转换为数组？

  • 772

我已经完成了一个宏代码，我可以在其中显示包含“过期”一词的行并隐藏包含单词（已完成、待定、进行中、已延迟）的其他行。一切进展顺利，但需要 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
macros

1 个回答

  1. Best Answer

    首先，您可以显着缩短宏代码：

    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
    • 1

相关问题