Question

我正在寻求加快流程。我有一个类似于以下内容的电子表格：

我具有以下数据结构：

+-------------------+
| Excel Ranged Name |
+-------------------+
| Name1             |
| Name2             |
| Name3             |
| Name4             |
| Name5             |
| Name6             |
| Name7             |
| Name8             |
| Name9             |
| Name10            |
| Name11            |
+-------------------+

其中Name1，Name2等都代表电子表格上的实际范围名称。即有一个名为“ Name1”等的单元格。

我想创建一个宏，该宏将清除每个命名范围的内容。我可以通过for循环来做到这一点：

Sub cleartest()

For i = 1 To 35000
    With Sheets("Sheet1")
        .Range(Cells(i, 1)).ClearContents
    End With
Next i




End Sub

但是，由于需要清除35000左右，因此PC需要30-40秒。如果可能的话，我正在寻找一种加快速度的方法。

我还禁用了自动计算，事件等。

Answer 1

Option Explicit

Sub t()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Dim rng As Range
Set rng = Range("A2:A3") ' this is the range where your named ranges are kept

Dim cel As Range

For Each cel In rng
    Range(cel.Value).ClearContents
Next cel

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

End Sub

Answer 2

这使用字典收集各自工作表上的所有命名范围，并将它们合并为一个范围，然后循环浏览包含命名范围的工作表并清除其内容。这对您来说应该很快执行：

编辑：宏现在将仅通过指定列表中存在的命名范围。

编辑2 ：现在，宏将说明已合并单元格的命名范围。

编辑3 ：该宏现在将说明具有多个不连续范围区域的命名范围，其中一个或多个区域是合并单元格

编辑4 ：现在，该宏解决了过时命名范围中可能出现的#REF错误。

编辑5 ：现在，该宏用于说明名称中带有空格的工作表。

Sub tgr()

    Dim wb As Workbook
    Dim wsNamedRangeList As Worksheet
    Dim rNamedRangeList As Range
    Dim rName As Range
    Dim rTest As Range
    Dim aAreas As Variant
    Dim vArea As Variant
    Dim vName As Variant
    Dim vSheetNamesRange As Variant
    Dim hSheets As Object
    Dim sSheet As String
    Dim sRange As String

    Set wb = ActiveWorkbook
    Set wsNamedRangeList = wb.Sheets("NamedRangeList")  'Change this to the actual name of the worksheet containing the list of named range names
    Set rNamedRangeList = wsNamedRangeList.Columns("A") 'Change this to the actual column containing the list of named range names
    Set hSheets = CreateObject("Scripting.Dictionary")

    For Each vName In wb.Names
        Set rTest = rNamedRangeList.Find(vName.Name, , xlValues, xlWhole, , , False)
        If Not rTest Is Nothing Then
            aAreas = Split(vName, ",")
            For Each vArea In aAreas
                sSheet = Split(vArea, "!")(0)
                If Left(sSheet, 1) = "=" Then sSheet = Mid(sSheet, 2)
                If Left(sSheet, 1) = "'" Then sSheet = Mid(sSheet, 2, Len(sSheet) - 2)
                sRange = Split(vArea, "!")(1)
                If sSheet <> "#REF" And sRange <> "#REF" Then
                    Set rName = wb.Sheets(sSheet).Range(sRange)
                    If hSheets.Exists(sSheet) Then
                        Set hSheets(sSheet) = Union(hSheets(sSheet), rName.MergeArea)
                    Else
                        Set hSheets(sSheet) = rName.MergeArea
                    End If
                End If
            Next vArea
        End If
    Next vName

    For Each vSheetNamesRange In hSheets.Items
        vSheetNamesRange.ClearContents
    Next vSheetNamesRange

End Sub

Answer 3

Option Explicit

Sub t()
On Error GoTo exitErr
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Dim rng As Range
Set rng = Range("A2:A3") ' this is the range where your named ranges are kept

Dim nmRng As Range, cel As Range

For Each cel In rng
    Range(cel.Value).ClearContents
Next cel

ExitErr:
   Application.ScreenUpdating = True
   Application.EnableEvents = True
   Application.Calculation = xlCalculationAutomatic

End Sub

@BruceWayne-请处理错误。为什么这个这么重要？？如果列表中的范围之一不存在怎么办？您的代码中断，屏幕更新处于关闭状态，事件不会触发，并且您的公式由于已关闭并且永远不会重新打开而停止计算。

Answer 4

使用您要清除的名称范围调用ClearNamedRanges

这会遍历活动工作簿中的所有命名范围，并在找到的名称范围内清除内容。

编辑：我相信Application.Match的运行速度可能比Range.Find Test都快。

public static int RoundToInt(float f) { return (int)Math.Round(f); }

Answer 5

我很好奇这是否会更快。我遍历一个数组，而不是访问.Range和Cells两次，而是遍历一个数组，因此循环中只有一个工作表引用。

Sub cleartest()

    Dim RangeNames() as Variant

    RangeNames = Worksheets("Sheet1").Range("A1:A35000").value
    For i = 1 To 35000
        With Sheets("Sheet1")
            .Range(RangeNames(i,1)).ClearContents
        End With
    Next i

End Sub

如果您只想清除值，可以尝试使用.Range(RangeNames(i,1)).Value = vbNullString。我认为它不会清除任何格式。

Answer 6

您可以尝试仅管理非空的“对象”（具有命名范围名称和命名范围本身的单元格）

Sub clear()
    Dim namedRangeCells As Range, cell As Range

    With Sheets("Sheet1") ' reference your sheet
        Set namedRangeCells = .Cells(1, 1) ' set namedRangeCells to a cell you don't care about
        For Each cell In .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeConstants) ' loop thropugh referenced sheet column A not empty cells
            Set namedRangeCells = Union(namedRangeCells, .Range(cell.Value)) ' collect named ranges
        Next
    End With

    namedRangeCells.SpecialCells(xlCellTypeConstants).ClearContents ' clear collected named ranges with with not empty value
End Sub

VBA-一次清除数千个单元

6 个答案: