表根据范围干扰VBA范围变量

Question

Excel文件包括部署在表(VBA列表对象)中的VBA编码的用户定义函数(UDF).现在,出于逃避我的原因,如果UDF模块包含在任何子函数或函数范围之外声明的Range变量,则在打开文件时会收到非常明显的警告:"自动错误 - 灾难性故障".

"灾难性"似乎是夸大其词,因为在警告被驳回后,文件似乎正常工作.但我仍然想了解问题所在.我已设法用MVC示例复制该问题,如下所示.我在Windows 10上运行Excel 2016(已更新).

有两个表(即VBA listobjects):表1列出了"项目"和表2中列出了"项目特征"(通过选择数据和点击生成两个表Table的上Insert标签).表2 ITEM_NAME()在字段Item_Name中调用了一个UDF ,它返回项目名称作为项目ID的函数,请参见屏幕截图:

该函数ITEM_NAME()本质上是常规工作表函数INDEX和MATCH的包装器,如下面的代码所示:

Option Explicit

Dim mrngItemNumber As Range
Dim mrngItemName As Range

Public Function ITEM_NAME(varItemNumber As Variant) As String
' Returns Item Name as a function of Item Number.
    Set mrngItemNumber = Sheets(1).Range("A4:A6")
    Set mrngItemName = Sheets(1).Range("B4:B6")
    ITEM_NAME = Application.WorksheetFunction.Index(mrngItemName, _
    Application.WorksheetFunction.Match(varItemNumber, mrngItemNumber))
End Function

因此,重复一下,使用此设置,我会在打开文件时收到Automation错误.但是,当我执行以下任何操作时,错误消失:

1. 将声明移动到函数的范围内.这个解决方案没有吸引力,因为它需要更多的代码行,每个UDF对应一行,并且有许多代码.

2. 将变量类型从Range更改为其他内容,例如Integer(因此该函数显然不起作用).

3. 将表2转换为普通范围(即删除表).这也是一个不方便的解决方案,因为我真的想在我的代码中将Table功能用于其他目的.

4. ITEM_NAME()从表2中删除该功能.(显然没有吸引力的选项..)

这是怎么回事？为什么我收到错误消息？为什么尽管有警告,文件似乎仍能正常工作？有没有我错过的解决方法？

我怀疑它可能与工作表对象和列表对象的交互方式有关,但不确定.在另一个问题的答案中提供了一个可能的提示:

如果要在不使用工作表的情况下引用表,可以使用hack Application.Range(ListObjectName).ListObject.

注意:此hack依赖于以下事实:Excel始终为表的DataBodyRange创建一个名称范围,其名称与表的名称相同.

其他地方(Stackoverflow和Microsoft Technet)也报告了类似的问题,但没有这种特殊的味道.建议的解决方案包括检查损坏的引用或在后台运行的其他进程,我这样做无济于事.我还可以补充一点,ITEM_NAME在创建表2之后是否输入函数没有任何区别; 唯一的区别是它在这种情况下使用结构化引用(如上面的屏幕截图所示).

更新:受@ SJR以下评论的启发,我尝试了以下代码变体,其中声明了一个ListObject变量来存储表"Items".请注意,Range声明现在位于函数的范围内,并且只有ListObject声明在外部.这也会产生相同的自动化错误!

Option Explicit

Dim mloItems As ListObject

Public Function ITEM_NAME(varItemNumber As Variant) As String
' Returns Item Name as a function of Item Number.
    Dim rngItemNumber As Range
    Dim rngItemName As Range
    Set mloItems = Sheet1.ListObjects("Items")
    Set rngItemNumber = mloItems.ListColumns(1).DataBodyRange
    Set rngItemName = mloItems.ListColumns(2).DataBodyRange
    ITEM_NAME = Application.WorksheetFunction.Index(rngItemName, _
    Application.WorksheetFunction.Match(varItemNumber, rngItemNumber))
End Function

更新2:问题现在似乎已经解决了,但我对实际造成的问题并不是很明智.由于没有人可以复制(甚至不是我的朋友在不同的系统上打开相同的文件),我开始认为这是一个本地问题.我尝试修复Excel,然后甚至从头开始重新安装完整的Office软件包.但问题仍然存在,包括用于创建上述示例的MCV文件和我发现问题的原始文件.

我决定尝试创建一个新版本的MCV示例,其中受到AndrewD的答案的启发,我曾经.ListObjects()设置范围而不是使用.Range().这确实有效.我可能会为我的工作调整该解决方案(但请参阅我在AndrewD的问题下的评论,解释我可能更喜欢的原因.Range().)

为了仔细检查这个解决方案是否有效,我开始创建两个新文件,一个用于复制我自己的示例,如上所述,另一个是唯一的区别是切换到ListObjects().在这个过程中,我注意到我实际上Range在原始文件的代码开头缩进了声明,如下所示:

Option Explicit

    Dim mrngItemNumber As Range
    Dim mrngItemName As Range

Public Function ITEM_NAME(...

在没有考虑这个问题的情况下,我创建了新文件,但没有缩进.因此,这将是前一个文件(以及上面给出的示例)的精确副本,但没有缩进.但是,有了这个文件,我无法复制自动化错误!在检查了两个文件后,我注意到唯一的区别是确实是缩进,所以我将缩进再次放回新文件中,期望它再次生成自动化错误.但问题没有再出现.然后我从第一个文件中删除了缩进(用于创建上面的示例),现在自动化错误也从该文件中消失了.有了这个观察结果,我回到了我的真实文件,我第一次发现了这个问题,并简单地删除了那里的缩进.它奏效了.

总而言之,在删除Range声明的缩进后,我无法在以前生成它的三个文件中的任何一个中重新创建自动化错误.而且,即使我再次将缩进放回原位,问题也不再出现.但我仍然不明白为什么.

感谢所有花时间看这个并分享宝贵意见的人.

Answer 1

声明模块级变量只是为了保存每个 UDF 中本来需要的两行，这确实是不好的编码实践。但是，如果您是这样想的，为什么不一路走下去，避免在每个 UDF中设置四行，从而节省四行！

\n\n

您可以通过使用伪常量函数来做到这一点，如以下代码所示：

\n\n

Option Explicit\n\nPrivate Function rng_ItemNumber() As Range\n    Set rng_ItemNumber = Sheet1.Range("A4:A6")\nEnd Function\nPrivate Function rng_ItemName() As Range\n    Set rng_ItemName = Sheet1.Range("B4:B6")\nEnd Function\n\nPublic Function ITEM_NAME(varItemNumber As Variant) As String\n\' Returns Item Name as a function of Item Number.\n  With Application.WorksheetFunction\n    ITEM_NAME = .Index(rng_ItemName, .Match(varItemNumber, rng_ItemNumber))\n  End With\nEnd Function\n

\n\n

当然，成本是函数调用的开销。

\n\n\n\n

如果您计划ListObject在最终设计中使用该类，那么为什么不现在使用它，并且还使用动态命名范围（示例中的硬编码范围在那里，因此它实际上按原样工作 - 这些应该替换为命名范围）：

\n\n

Option Explicit\n\nPrivate Function str_Table1() As String\n    Static sstrTable1 As String\n    If sstrTable1 = vbNullString Then\n      sstrTable1 = Sheet1.Range("A4:B6").ListObject.Name\n    End If\n    str_Table1 = sstrTable1\nEnd Function\nPrivate Function str_ItemNumber() As String\n    Static sstrItemNumber As String\n    If sstrItemNumber = vbNullString Then\n      sstrItemNumber = Sheet1.Range("A4:A6").Offset(-1).Resize(1).Value2\n    End If\n    str_ItemNumber = sstrItemNumber\nEnd Function\nPrivate Function str_ItemName() As String\n    Static sstrItemName As String\n    If sstrItemName = vbNullString Then\n      sstrItemName = Sheet1.Range("B4:B6").Offset(-1).Resize(1).Value2\n    End If\n    str_ItemName = sstrItemName\nEnd Function\n\nPublic Function ITEM_NAME(varItemNumber As Variant) As String\n  \'Returns Item Name as a function of Item Number.\n  Dim \xc6\x92 As WorksheetFunction: Set \xc6\x92 = WorksheetFunction\n  With Sheet1.ListObjects(str_Table1)\n    ITEM_NAME _\n    = \xc6\x92.Index _\n      ( _\n        .ListColumns(str_ItemName).DataBodyRange _\n      , \xc6\x92.Match(varItemNumber, .ListColumns(str_ItemNumber).DataBodyRange) _\n      )\n  End With\nEnd Function\n

\n\n

一旦逻辑/设计准备就绪，如果速度至关重要并且需要回收函数调用开销，则可以将函数替换为同名的模块级常量。否则，您可以将一切保留原样。

\n\n

请注意，静态变量的使用不是必需的，但应该减少执行时间。（静态变量也可以在第一个示例中使用，但为了简短起见，我将它们省略了。）

\n\n

可能实际上没有必要将表名提取为伪常量，但为了完整性我这样做了。

\n\n\n\n

编辑：（v2）

\n\n

遵循 Egalth 的两个出色建议，产生了以下代码，当我们利用 ListObject 表本身的内置动态时，它消除了对命名范围甚至硬编码单元格地址的需要。

\n\n

我还更改了参数名称以匹配*相关的列标题名称，因此当用户按Ctrl+ Shift+时A，会出现有关要使用哪个列的提示。（可以在此处查看此提示以及有关如何添加 Intellisense 工具提示和/或在“函数参数”对话框中显示说明的更多信息（如果需要）。）

\n\n

Option Explicit\n\nPrivate Function str_Table1() As String\n    Static sstrTable1 As String\n    If sstrTable1 = vbNullString Then sstrTable1 = Sheet1.ListObjects(1).Name \' or .ListObjects("Table1").Name\n    str_Table1 = sstrTable1\nEnd Function\nPrivate Function str_ItemNumber() As String\n    Static sstrItemNumber As String\n    If sstrItemNumber = vbNullString Then\n      sstrItemNumber = Sheet1.ListObjects(str_Table1).HeaderRowRange(1).Value2\n    End If\n    str_ItemNumber = sstrItemNumber\nEnd Function\nPrivate Function str_ItemName() As String\n    Static sstrItemName As String\n    If sstrItemName = vbNullString Then\n      sstrItemName = Sheet1.ListObjects(str_Table1).HeaderRowRange(2).Value2\n    End If\n    str_ItemName = sstrItemName\nEnd Function\n\nPublic Function ITEM_NAME(ByRef Item_ID As Variant) As String\n  \'Returns Item Name as a function of Item Number.\n  Dim \xc6\x92 As WorksheetFunction: Set \xc6\x92 = WorksheetFunction\n  With Sheet1.ListObjects(str_Table1)\n    ITEM_NAME _\n    = \xc6\x92.Index _\n      ( _\n        .ListColumns(str_ItemName).DataBodyRange _\n      , \xc6\x92.Match(Item_ID, .ListColumns(str_ItemNumber).DataBodyRange) _\n      )\n  End With\nEnd Function\n

\n\n

注意 的用法.Value2。.Value2自从我发现使用时.Value（或依赖它作为默认属性时）进行的隐式类型转换导致的性能拖累和其他问题以来，我一直在使用。

\n\n

_{* 确保在项目的逻辑/设计完成后更新代码中的列标题名称。}

\n\n\n\n

编辑：（重新启动）

\n\n

重新阅读您自己对发布的问题的评论，我注意到这一点：

\n\n

\n

我最终可能会采用这种方法，但我仍在设计过程中，并且经常移动列，因此索引号也可能会改变

\n

\n\n

虽然上面的最后一个示例允许动态更改标题名称，但移动/插入列会更改索引，需要修改代码。

\n\n

看起来我们又回到了使用命名范围。但是，这次我们只需要指向列标题的静态变量静态变量。

\n\n

事实证明，对于这种新情况，静态变量在设计阶段是一个坏主意。由于列索引已缓存，因此插入新列会破坏 UDF，直到项目重置为止。

\n\n

我还从您发布的问题中的引用中合并了无纸表参考黑客的缩短版本：

\n\n

Option Explicit\n\nPrivate Function str_Table1() As String\n    str_Table1 = Sheet1.ListObjects(1).Name\nEnd Function\nPrivate Function str_ItemNumber() As String\n    With Range(str_Table1).ListObject\n      str_ItemNumber = .HeaderRowRange(.Parent.Range("A3").Column - .HeaderRowRange.Column + 1).Value2\n    End With\nEnd Function\nPrivate Function str_ItemName() As String\n    With Range(str_Table1).ListObject\n      str_ItemName = .HeaderRowRange(.Parent.Range("B3").Column - .HeaderRowRange.Column + 1).Value2\n    End With\nEnd Function\n\nPublic Function ITEM_NAME(ByRef Item_ID As Variant) As String\n  \'Returns Item Name as a function of Item Number.\n  Dim \xc6\x92 As WorksheetFunction: Set \xc6\x92 = WorksheetFunction\n  With Range(str_Table1).ListObject\n    ITEM_NAME _\n    = \xc6\x92.Index _\n      ( _\n        .ListColumns(str_ItemName).DataBodyRange _\n      , \xc6\x92.Match(Item_ID, .ListColumns(str_ItemNumber).DataBodyRange) _\n      )\n  End With\nEnd Function\n

\n\n

请注意，您不能使用Item_name命名范围之一，因为它与 UDF 相同（忽略大小写）。我建议使用尾随下划线，例如Item_name_我建议对命名范围

\n\n\n\n

所有上述方法也可以解决您最初遇到的问题。我正在等待最后的信息，以便对这个问题最初发生的原因做出有根据的猜测。

\n