我可以缩短这段代码的执行时间吗?
Can I make this code execution time shorter?
此代码需要超过 10 秒才能完成。有更快的方法吗?
如果一行中的特定单元格由"H"个字符组成,则隐藏整行并在此处用给定的背景颜色解释单元格的内容,其索引代码为19。
Option Explicit
Sub TailoredInputs()
Dim ws As Worksheet
Dim i, j, l As Integer
Set ws = Sheets("Inputs")
Application.ScreenUpdating = False
Range("A7:A200").EntireRow.Hidden = False
With ws
.Select
j = 10
Do While j <= 149
If .Cells(j, "J").Value = "H" Then
For l = 4 To 9
If .Cells(j, l).Interior.ColorIndex = 19 Then
.Cells(j, l).ClearContents
Else: End If
Next l
.Cells(j, "J").EntireRow.Hidden = True
Else: End If
If .Cells(j, "K").Value = "H" Then
For l = 4 To 9
If .Cells(j, l).Interior.ColorIndex = 19 Then
.Cells(j, l).ClearContents
Else: End If
Next l
.Cells(j, "J").EntireRow.Hidden = True
Else: End If
j = j + 1
Loop
Range("Spendinginput").Select
End With
Application.ScreenUpdating = True
End Sub
我要看的第一件事是摆脱第 10 行到第 149 行的显式循环。
您可以改为使用 Range.Find
方法在您感兴趣的范围内找到第一个包含 H
的单元格。对于所有潜在的优化,您应该检查它,但我想Excel 在幕后搜索值可能比手动检查每个单元格更快。
例如,考虑以下代码:
Option Explicit
Public Declare PtrSafe Function GetTickCount Lib "kernel32.dll" () As Long
Sub Macro1()
Dim ws As Worksheet
Dim j As Integer
Dim t As Long
Dim x As Range
If False Then ' or use true for explicit loop '
t = GetTickCount
j = 1
Do While j <= 9999
If Worksheets(1).Cells(j, 1).Value = "H" Then
MsgBox ("found it " & j & " " & (GetTickCount - t))
j = 10000
End If
j = j + 1
Loop
Else
t = GetTickCount
Set x = Range("A1:A9999").Find("H")
MsgBox ("found it " & x.Row & " " & (GetTickCount - t))
End If
End Sub
在 if
语句(显式循环)中使用 true
并且在单元格 A9999
中只有一个 H
的工作表,大约需要 46 毫秒才能找到价值。使用 Range.Find()
方法将其降为零。
未测试:
Sub TailoredInputs()
Dim ws As Worksheet
Dim i, j, l As Integer, rngHide As Range
Set ws = Sheets("Inputs")
Application.ScreenUpdating = False
ws.Range("A7:A200").EntireRow.Hidden = False
For j = 10 To 149
If ws.Cells(j, "J").Value = "H" Or ws.Cells(j, "K").Value = "H" Then
For l = 4 To 9
If ws.Cells(j, l).Interior.ColorIndex = 19 Then
ws.Cells(j, l).ClearContents
End If
Next l
'build the range which will be hidden
If rngHide Is Nothing Then
Set rngHide = ws.Cells(j, 1)
Else
Set rngHide = Application.Union(rngHide, ws.Cells(j, 1))
End If
End If
Next j
'anything to hide? Hide it.
If Not rngHide Is Nothing Then rngHide.EntireRow.Hidden = True
ws.Range("Spendinginput").Select
Application.ScreenUpdating = True
End Sub
此代码需要超过 10 秒才能完成。有更快的方法吗?
如果一行中的特定单元格由"H"个字符组成,则隐藏整行并在此处用给定的背景颜色解释单元格的内容,其索引代码为19。
Option Explicit
Sub TailoredInputs()
Dim ws As Worksheet
Dim i, j, l As Integer
Set ws = Sheets("Inputs")
Application.ScreenUpdating = False
Range("A7:A200").EntireRow.Hidden = False
With ws
.Select
j = 10
Do While j <= 149
If .Cells(j, "J").Value = "H" Then
For l = 4 To 9
If .Cells(j, l).Interior.ColorIndex = 19 Then
.Cells(j, l).ClearContents
Else: End If
Next l
.Cells(j, "J").EntireRow.Hidden = True
Else: End If
If .Cells(j, "K").Value = "H" Then
For l = 4 To 9
If .Cells(j, l).Interior.ColorIndex = 19 Then
.Cells(j, l).ClearContents
Else: End If
Next l
.Cells(j, "J").EntireRow.Hidden = True
Else: End If
j = j + 1
Loop
Range("Spendinginput").Select
End With
Application.ScreenUpdating = True
End Sub
我要看的第一件事是摆脱第 10 行到第 149 行的显式循环。
您可以改为使用 Range.Find
方法在您感兴趣的范围内找到第一个包含 H
的单元格。对于所有潜在的优化,您应该检查它,但我想Excel 在幕后搜索值可能比手动检查每个单元格更快。
例如,考虑以下代码:
Option Explicit
Public Declare PtrSafe Function GetTickCount Lib "kernel32.dll" () As Long
Sub Macro1()
Dim ws As Worksheet
Dim j As Integer
Dim t As Long
Dim x As Range
If False Then ' or use true for explicit loop '
t = GetTickCount
j = 1
Do While j <= 9999
If Worksheets(1).Cells(j, 1).Value = "H" Then
MsgBox ("found it " & j & " " & (GetTickCount - t))
j = 10000
End If
j = j + 1
Loop
Else
t = GetTickCount
Set x = Range("A1:A9999").Find("H")
MsgBox ("found it " & x.Row & " " & (GetTickCount - t))
End If
End Sub
在 if
语句(显式循环)中使用 true
并且在单元格 A9999
中只有一个 H
的工作表,大约需要 46 毫秒才能找到价值。使用 Range.Find()
方法将其降为零。
未测试:
Sub TailoredInputs()
Dim ws As Worksheet
Dim i, j, l As Integer, rngHide As Range
Set ws = Sheets("Inputs")
Application.ScreenUpdating = False
ws.Range("A7:A200").EntireRow.Hidden = False
For j = 10 To 149
If ws.Cells(j, "J").Value = "H" Or ws.Cells(j, "K").Value = "H" Then
For l = 4 To 9
If ws.Cells(j, l).Interior.ColorIndex = 19 Then
ws.Cells(j, l).ClearContents
End If
Next l
'build the range which will be hidden
If rngHide Is Nothing Then
Set rngHide = ws.Cells(j, 1)
Else
Set rngHide = Application.Union(rngHide, ws.Cells(j, 1))
End If
End If
Next j
'anything to hide? Hide it.
If Not rngHide Is Nothing Then rngHide.EntireRow.Hidden = True
ws.Range("Spendinginput").Select
Application.ScreenUpdating = True
End Sub