表根据范围

时间:2017-09-05 14:59:54

标签: excel vba excel-vba excel-2016

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

"灾难性"看起来有点夸张,因为在警告被取消后,该文件似乎正常工作。但我仍然想了解问题所在。我已设法用MVC示例复制该问题,如下所示。我在Windows 10上运行Excel 2016(已更新)。

有两个表(即VBA列表对象):表1 列表"项目"和表2 列出"项目功能" (两个表格都是通过选择数据并点击Table标签上的Insert)生成的。表2在字段ITEM_NAME()中有一个名为Item_Name的UDF,它返回项目名称作为项目ID的函数,请参见屏幕截图:

enter image description here

函数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

所以,重复一遍,使用此设置,我会在打开文件时收到自动化错误 。但是,当我执行以下任何操作时,错误消失:

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

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

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

  4. 从表2中删除函数ITEM_NAME()。(显然没有吸引人的选择..)

  5. 发生了什么?为什么我收到错误消息?为什么尽管有警告,文件似乎仍能正常工作?有没有我错过的解决方法?

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

      

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

         

    注意:此hack依赖于Excel始终为其创建命名范围的事实   table的DataBodyRange与表名相同。

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

    更新:受到@ SJR以下评论的启发,我尝试了以下代码变体,其中声明 ListObject 变量来存储表&# 34;项目&#34 ;.请注意, 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 answer below的启发,我使用.ListObjects()来设置范围,而不是使用.Range() 。这确实有效。我可能会为我的工作调整该解决方案(但请参阅AndrewD的问题,解释为什么我可能更喜欢.Range()。)

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

    Option Explicit
    
        Dim mrngItemNumber As Range
        Dim mrngItemName As Range
    
    Public Function ITEM_NAME(...
    

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

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

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

3 个答案:

答案 0 :(得分:1)

行。此解决方法工作。

如果当它出现时,有一些问题需要解决。

我也会发布解释。

ThisWorkbook模块中安装代码。

<强>代码:

Private Sub Workbook_BeforeClose(Cancel As Boolean)

  Dim rngCell As Range

  For Each rngCell In ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas)
    With rngCell
      If .FormulaR1C1 Like "*ITEM_NAME*" _
      And Left$(.FormulaR1C1, 4) <> "=T(""" _
      Then
        .Value = "=T(""" & .FormulaR1C1 & """)"
      End If
    End With
  Next rngCell

End Sub

Private Sub Workbook_Open()

  Dim rngCell As Range

  For Each rngCell In ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas)
    With rngCell
      If .FormulaR1C1 Like "*ITEM_NAME*" _
      And Left$(.FormulaR1C1, 4) = "=T(""" _
      Then
        .FormulaR1C1 = .Value
      End If
    End With
  Next rngCell

End Sub

答案 1 :(得分:1)

在纯粹的代码级别,为什么在每次设置时都会声明模块级变量来存储范围?如果您正在缓存引用并且仅在我无法理解的情况下设置它们...但是您将使用静态来缩小范围。

我的偏好是不打扰模块化(或本地/静态)变量,用 Worksheet.CodeName 替换 Worksheet.Name 引用(不太可能是更改,如果您在重命名后编译,则会收到错误)并通过 ListObject ListColumns 引用表格范围(如果表格大小发生变化)。

' Returns the item name for the requested item ID.
Public Function ITEM_NAME(ByVal ItemID As Variant) As String
    ITEM_NAME = Application.WorksheetFunction.Index( _
                      Sheet1.ListObjects("Table1").ListColumns("Item_name").DataBodyRange _
                    , Application.WorksheetFunction.Match( _
                          ItemID _
                        , Sheet1.ListObjects("Table1").ListColumns("Item_ID").DataBodyRange _
                        ) _
                    )
End Function

最强大的解决方案将避免使用UDF并使用=INDEX(Table1[Item_name],MATCH([@[Item_ID]],Table1[Item_ID]‌​))(VLOOKUP可能会稍微快一些,但INDEX + MATCH更强大)。

答案 2 :(得分:1)

声明模块级变量只是为了保存每个UDF中原本需要的两行,这实际上是错误的编码实践。但是,如果这是您的想法,那么为什么不通过 设置 四个 行>他们每个人都在!

您可以使用伪常量函数执行此操作,如以下代码所示:

Option Explicit

Private Function rng_ItemNumber() As Range
    Set rng_ItemNumber = Sheet1.Range("A4:A6")
End Function
Private Function rng_ItemName() As Range
    Set rng_ItemName = Sheet1.Range("B4:B6")
End Function

Public Function ITEM_NAME(varItemNumber As Variant) As String
' Returns Item Name as a function of Item Number.
  With Application.WorksheetFunction
    ITEM_NAME = .Index(rng_ItemName, .Match(varItemNumber, rng_ItemNumber))
  End With
End Function

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

如果您计划在最终设计中使用ListObject类,那么为什么不立即使用它, 以及 使用动态命名范围(示例中的硬编码范围是存在的,因此它实际上按原样工作 - 这些应该用命名范围替换:

Option Explicit

Private Function str_Table1() As String
    Static sstrTable1 As String
    If sstrTable1 = vbNullString Then
      sstrTable1 = Sheet1.Range("A4:B6").ListObject.Name
    End If
    str_Table1 = sstrTable1
End Function
Private Function str_ItemNumber() As String
    Static sstrItemNumber As String
    If sstrItemNumber = vbNullString Then
      sstrItemNumber = Sheet1.Range("A4:A6").Offset(-1).Resize(1).Value2
    End If
    str_ItemNumber = sstrItemNumber
End Function
Private Function str_ItemName() As String
    Static sstrItemName As String
    If sstrItemName = vbNullString Then
      sstrItemName = Sheet1.Range("B4:B6").Offset(-1).Resize(1).Value2
    End If
    str_ItemName = sstrItemName
End Function

Public Function ITEM_NAME(varItemNumber As Variant) As String
  'Returns Item Name as a function of Item Number.
  Dim ƒ As WorksheetFunction: Set ƒ = WorksheetFunction
  With Sheet1.ListObjects(str_Table1)
    ITEM_NAME _
    = ƒ.Index _
      ( _
        .ListColumns(str_ItemName).DataBodyRange _
      , ƒ.Match(varItemNumber, .ListColumns(str_ItemNumber).DataBodyRange) _
      )
  End With
End Function

一旦逻辑/设计准备就绪,如果速度很关键并且您需要回收函数调用开销,则可以使用相同名称的模块级常量替换这些函数。否则,你可以保持原样。

请注意,不需要使用静态变量,但应减少执行时间。 (静态变量也可以在第一个例子中使用,但是我把它们留了下来以保持简短。)

可能没有必要将表名提取为伪常量,但为了完整起见,我已经这样做了。

编辑:(v2)

跟进Egalth的两个出色建议,导致以下代码不再需要命名范围, 甚至是硬编码的单元格地址 ,因为我们可以利用ListObject表本身的内置动态。

我还更改了参数名称以匹配*相关的列标题名称,因此当用户按 Ctrl + Shift + A a时提示使用哪个列。 (如果需要,可以看到有关如何添加智能感知工具提示和/或获取描述以显示在“函数参数”对话框中的更多信息here

Option Explicit

Private Function str_Table1() As String
    Static sstrTable1 As String
    If sstrTable1 = vbNullString Then sstrTable1 = Sheet1.ListObjects(1).Name ' or .ListObjects("Table1").Name
    str_Table1 = sstrTable1
End Function
Private Function str_ItemNumber() As String
    Static sstrItemNumber As String
    If sstrItemNumber = vbNullString Then
      sstrItemNumber = Sheet1.ListObjects(str_Table1).HeaderRowRange(1).Value2
    End If
    str_ItemNumber = sstrItemNumber
End Function
Private Function str_ItemName() As String
    Static sstrItemName As String
    If sstrItemName = vbNullString Then
      sstrItemName = Sheet1.ListObjects(str_Table1).HeaderRowRange(2).Value2
    End If
    str_ItemName = sstrItemName
End Function

Public Function ITEM_NAME(ByRef Item_ID As Variant) As String
  'Returns Item Name as a function of Item Number.
  Dim ƒ As WorksheetFunction: Set ƒ = WorksheetFunction
  With Sheet1.ListObjects(str_Table1)
    ITEM_NAME _
    = ƒ.Index _
      ( _
        .ListColumns(str_ItemName).DataBodyRange _
      , ƒ.Match(Item_ID, .ListColumns(str_ItemNumber).DataBodyRange) _
      )
  End With
End Function

请注意.Value2的使用情况。自从我发现使用.Value2(或依赖它作为默认属性)时完成的隐式类型转换所导致的性能拖拽和其他问题时,我一直使用.Value

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

编辑:(重新启动)

重新阅读您对发布的问题的评论,我注意到this one

  

我最终可能会采用这种方法,但我仍处于设计过程中并且需要大量移动列,因此索引号也可能会发生变化

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

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

事实证明,对于这个新案例,静态变量在设计阶段是一个糟糕的想法。由于列索引已缓存,因此插入新列会破坏UDF,直到重置项目为止。

我还在您发布的问题的引文中加入了无表格表格引用黑客的缩短版本:

Option Explicit

Private Function str_Table1() As String
    str_Table1 = Sheet1.ListObjects(1).Name
End Function
Private Function str_ItemNumber() As String
    With Range(str_Table1).ListObject
      str_ItemNumber = .HeaderRowRange(.Parent.Range("A3").Column - .HeaderRowRange.Column + 1).Value2
    End With
End Function
Private Function str_ItemName() As String
    With Range(str_Table1).ListObject
      str_ItemName = .HeaderRowRange(.Parent.Range("B3").Column - .HeaderRowRange.Column + 1).Value2
    End With
End Function

Public Function ITEM_NAME(ByRef Item_ID As Variant) As String
  'Returns Item Name as a function of Item Number.
  Dim ƒ As WorksheetFunction: Set ƒ = WorksheetFunction
  With Range(str_Table1).ListObject
    ITEM_NAME _
    = ƒ.Index _
      ( _
        .ListColumns(str_ItemName).DataBodyRange _
      , ƒ.Match(Item_ID, .ListColumns(str_ItemNumber).DataBodyRange) _
      )
  End With
End Function

请注意,您不能将Item_name用于其中一个命名范围,因为它与UDF相同(忽略大小写)。我建议为你的命名范围使用尾随下划线,例如Item_name_

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