Question

如果该范围内的单元格具有＆＃34; NA＆＃34;，我希望通过使用If WorksheetFunction.CountA(Range("A1:D500")) = "NA" Then清除内容来提高宏的效率。

我需要存储宏的当前选择，因为工作表中的值存储在不同的位置。

我正在使用此代码

Range("C6").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select

For N = 3 To 15
Sheets(N).Activate
    Dim rng As Range
    For Each rng In Selection
        If IsError(rng) Then
        rng.ClearContents
        Else
        rng.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        End If
       Next rng
Next N

这个循环在每个单元格中查找当前选择但是我有15张要查找并删除每个单元格＃NA;＃＆＃34;价值因此需要太长时间。

Answer 1

很抱歉没有加入CountA功能，但我相信你会对效率和效率的大幅提升感到满意。大约 555,000％的速度增加！（根据执行我的代码执行代码的时间计算）。这是一个很长的阅读，但希望有价值和教育。

如果你觉得需要速度＆＃34;在您的代码中，使用它是个好主意：

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
    'your code here
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

在您的程序中，除非需要连续计算或您特别希望运行事件过程。如果您正在显示消息框或用户表单，则可能需要暂时允许ScreenUpdating。

为了证明这一点，我创建了一个包含18个相同工作表的工作簿，其中主要包含A1中的值：D500加上66个Vlookup，评估为每张＃N / A.我将您的代码放在名为DeleteErrorsUsingLoops（）的过程中。我确保在每张纸上选择了C6：D500并按原样运行你的代码，但是添加了一个计时器。

Sub DeleteErrorsUsingLoops()
Range("C6").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select

Dim StartTime As Date
StartTime = Now()
Dim N As Long
For N = 3 To 15
Sheets(N).Activate
    Dim rng As Range
    For Each rng In Selection
        If IsError(rng) Then
        rng.ClearContents
        Else
        rng.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        End If
       Next rng
Next N
MsgBox Format(Now() - StartTime, "hh:mm:ss.000000")
End Sub

在一台运行速度为3.6Ghz且内存为8GB的i7-3820四核上运行需要11分钟，1秒钟。我感觉到你的痛苦！

关闭屏幕更新再次运行它，花了39秒，这是 1,692％的改善。

在这种情况下禁用计算和事件没有区别，因为被删除的单元格没有依赖项，因此不需要重新计算，并且我的工作簿中没有事件过程。

谨慎使用循环

有时您必须使用循环来循环浏览书籍或工作表集合。这通常不是问题，因为数字相对较小。

当您开始遍历某个范围内的每个单元格并执行多个操作（选择，评估，清除，复制，粘贴）时，即使您没有被迫观看它，也需要花费时间。

不是在13张纸上循环遍历所有990个单元格，而是使用等效的Find＆amp; amp;选择...转到...特殊...公式...错误（仅限），如果您在工作表上选择了所有＆＃34;＃N / A＆＃34;＆＃39; s。我录制了一个宏：

Sub SelectErrors()
'
' SelectErrors Macro
'

'
    Selection.SpecialCells(xlCellTypeFormulas, 16).Select
End Sub

然后，您可以使用Selection.ClearContents清除选择，但我不喜欢使用选择，选择（除非它后面是大小写）或激活。因此，我不使用录制的宏代码，而是使用类似的内容：

[C6:D500].SpecialCells(xlCellTypeFormulas, xlErrors).ClearContents

避免激活并选择

它们会导致速度受损（即速度慢下来）
会导致错误和不可预测的结果。例如，在您的代码中，如果除了您的第一张纸张之外的所有纸张中都选择了单元格A1，则仅在这些纸张上测试A1。当您的程序运行得更快但您没有删除第4至第15页中的错误时，您可能会感觉良好。

改为使用With...End With构造 这些减少了重复。你可以写

Sheets(x).[C6:D500].SpecialCells(xlCellTypeFormulas, xlErrors).ClearContents
Sheets(x).[C6:D500].Copy
Sheets(x).[C6:D500].PasteSpecial xlPasteValues

或者您可以取出共同表达式Sheets(x).[C6:D500]并输入With：

With Sheets(x).[C6:D500] 'define range you want to work on
    .SpecialCells(xlCellTypeFormulas, xlErrors).ClearContents
    .Copy
    .PasteSpecial xlPasteValues
End With

请注意，With ... End With中的每个表达式都以点（。）开头。

将上述所有内容放在一起以获得快速：

Sub FindAndDeleteErrors()
'Clears contents in cells returning errors while leaving formats
'within a defined range on all sheets within a workbook.
'Assumes no Chart sheets in workbook else use Worksheets collection.

Dim ErrorMsg As String 'just in case!
Dim ws As Worksheet
Dim StartTime
Dim x As Long 'arguably faster than Integer - Google it.
    On Error GoTo Ender:
    StartTime = MicroTimer 'An API function appended below.
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    For x = 3 To 15 'set up Sheet loop boundaries
        With Sheets(x).[C6:D500] 'define range you want to work on
            'test that there will be error cells to work on to avoid error
            On Error Resume Next 'will error in no xlErrors in range
            If Err > 0 Then
                ErrorMsg = "An " & Err.Number & " error (" & Error & ") occurred in sheet " & Sheets(x).Name
            End If
            .SpecialCells(xlCellTypeFormulas, xlErrors).ClearContents
            On Error GoTo Ender:
            .Copy
            .PasteSpecial xlPasteValues
            Application.CutCopyMode = False 'clear the clipboard
        End With
    Next x
    StartTime = MicroTimer - StartTime 'calculate elapsed time
    StartTime = Round(StartTime, 5) 'show it to 5 decimals
    MsgBox CDbl(StartTime)
Ender:     'runs On Error to restore normal operation
    If ErrorMsg <> "" Then 'display error
        MsgBox ErrorMsg, vbCritical
    End If
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End Sub

MicroTimer功能已从Office development > Office clients > Office 2010 > Excel 2010 > Technical Articles > Excel 2010 Performance: Improving Calculation Performance

复制

Private Declare Function getFrequency Lib "kernel32" _
Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Private Declare Function getTickCount Lib "kernel32" _
Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long
Function MicroTimer() As Double
'

' Returns seconds.
    Dim cyTicks1 As Currency
    Static cyFrequency As Currency
    '
    MicroTimer = 0

' Get frequency.
    If cyFrequency = 0 Then getFrequency cyFrequency

' Get ticks.
    getTickCount cyTicks1

' Seconds
    If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency
End Function

很抱歉没有加入CountA功能，但我相当肯定你会对效率的大幅提升感到满意！＃/ p>

将选择存储在变量中

1 个答案: