我在运行下面代码中提到的清理名称实用程序时收到运行时错误 7 错误。我使用的是 512 GB 硬盘、8 GB RAM、I7 处理器,所以不应该是内存问题,但问题仍然会出现。
我的工作簿有 123188 个定义的名称,我想使用下面的代码删除它们。有没有办法提高代码效率/有人有代码/内置插件,我可以将其合并到主插件中?
该功能在
For Each objName In ActiveWorkbook.Names
任何帮助将不胜感激。
提前致谢
Option Explicit
Sub Cleanup_names123()
'
'Deletes all names except for Print_Area, Database, and DB
'Declare variables
Dim objName As Name
Dim strAnswer As String
'Display instructions
strAnswer = MsgBox("This function will delete all named ranges except Print_Area, DB, and Database. If you are not ready to proceed click Cancel to exit.", vbOKCancel)
'If cancelled - exit function
If strAnswer = vbCancel Then End
'If no names found, exit
If ActiveWorkbook.Names.Count = 0 Then
MsgBox "No names found. Macro complete."
End
End If
MsgBox ActiveWorkbook.Names.Count & " name(s) found. It may take a few minutes for the cleanup."
'Delete names
For Each objName In ActiveWorkbook.Names
On Error Resume Next
If InStr(objName.Name, "Database") <> 0 Then
'If Database - no action
ElseIf InStr(objName.Name, "database") <> 0 Then
'If database - no action
ElseIf InStr(objName.Name, "DB") <> 0 Then
'If database - no action
Else
objName.Delete
ThisWorkbook.Names(objName.Name).Delete
End If
Next
On Error GoTo 0
End Sub
最佳答案
如果迭代集合占用太多内存,您可以手动逐个选择每个项目。删除项目时,从最后开始倒退很重要,因为当您删除项目 1 时,项目 2 将变为项目 1。所以我们使用 Step -1
向后工作。
为了让你的保护条款读起来清楚并避免空的 If,我将逻辑更改为 If Not And
.我觉得这更清楚。不要使用下划线 _
在方法名称中,因为这是为事件方法保留的。
Option Explicit
Public Sub CleanupNames()
'
'Deletes all names except for Print_Area, Database, and DB
'Declare variables
Dim strAnswer As String
'Display instructions
strAnswer = MsgBox("This function will delete all named ranges except Print_Area, DB, and Database. If you are not ready to proceed click Cancel to exit.", vbOKCancel)
'If cancelled - exit function
If strAnswer = vbCancel Then Exit Sub
Dim NamesCount As Long
NamesCount = ActiveWorkbook.Names.Count
'If no names found, exit
If NamesCount = 0 Then
MsgBox "No names found. Macro complete."
Exit Sub
End If
MsgBox NamesCount & " name(s) found. It may take a few minutes for the cleanup."
'Delete names
Dim iter As Long
For iter = NamesCount To 1 Step -1
Dim objName As String
objName = ActiveWorkbook.Names.Item(iter).Name
On Error Resume Next
If Not InStr(objName, "Database") <> 0 And _
Not InStr(objName, "database") <> 0 And _
Not InStr(objName, "DB") <> 0 Then
ActiveWorkbook.Names(objName).Delete
End If
If iter Mod 5000 = 0 Then ActiveWorkbook.Save
Next iter
End Sub
更新:添加了保存代码并更改了删除行为。
关于excel - 新问题 - 运行时错误 - 内存不足,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/64070614/