☰

excel 2010 Vba，循环遍历命名范围，运行时错误“1004”：

tag-icon • tag-icon microsoft-excel microsoft-excel-2010 vba
excel 2010 Vba，循环遍历命名范围，运行时错误“1004”：

我正在将同一个宏分配给多个选项按钮。我尝试确定单击的 OButton 位于哪个命名范围。因此，我获取按钮的单元格并循环遍历工作表中的所有命名范围以查找相交的范围

我迄今为止的代码：

Sub OptionField()
Dim r As Range
Dim nm As Name
Set r = ActiveSheet.OptionButtons(Application.Caller).TopLeftCell

For Each nm In ActiveSheet.Names
  If InRange(r, ActiveSheet.Range(nm)) = True Then           
  'Loop with ActiveSheet.Range(nm) seems to cause this issue
   Debug.Print nm.Name
  End If
Next nm
End Sub

Function InRange(Range1 As Range, Range2 As Range) As Boolean
'returns True if Range1 is within Range2
 Dim InterSectRange As Range
 Set InterSectRange = Application.Intersect(Range1, Range2)
 InRange = Not InterSectRange Is Nothing
 Set InterSectRange = Nothing
 End Function

在我的代码中，只要有细微的变化，我就会收到两条错误消息，它们都指向同一个错误

错误消息 1：应用程序定义或对象定义的错误

错误消息 2：运行时错误“1004”：对象“_Global”的方法范围失败

我确实在 msdn 上找到了文档，但我就是无法“理解”它或者不知道如何修复它。

https://support.microsoft.com/en-us/kb/178510/en-us

所以我知道 VBA 占用了一个引用，我需要释放它，令我恼火的是循环在几次迭代中运行良好（不仅仅是第一次）然后失败了......

编辑：当命名范围引用与前一个范围相同的单元格时，它会失败。这样就解决了迭代问题

我尝试将循环修改为此，但是引用没有任何改变。

For Each nm In ActiveSheet.Names
Dim t As Range
Set t = ActiveSheet.Range(nm) 'it stops working here, when an ranges with same cells are called    
 If InRange(r, t) = True Then      
   Debug.Print nm.Name
  End If
Set t = Nothing
Next nm

任何帮助都将不胜感激

多谢

答案1

这能改善情况吗？

Function InRange(Range1 As Range, Range2 As Range) As Boolean
    'returns True if Range1 is within Range2
    Dim InterSectRange As Range

    InRange = False
    If Range1 Is Nothing Then
        MsgBox "Range1 is nothing"
        Exit Function
    End If
    If Range2 Is Nothing Then
        MsgBox "Range2 is nothing"
        Exit Function
    End If

    Set InterSectRange = Intersect(Range1, Range2)
    InRange = Not InterSectRange Is Nothing
    Set InterSectRange = Nothing
 End Function

编辑＃1

此外，在子OptionField()，命名范围可能指定过多。更改：

ActiveSheet.Range(nm)

简单来说：

Range(nm)

编辑＃2

例如

Sub demo2()
    Dim r As Range
    Set r = ActiveSheet.Range("A1")
    MsgBox r.Address
    MsgBox ActiveSheet.r.Address
End Sub

第一个 MsgBox 工作正常，但第二个失败了...........这是因为r已经完全合格，不需要工作表来再次合格。

相关内容