当 运行 宏 - Excel 崩溃时,变体数组为 'corrupted'

Variant array is 'corrupted' when running macro - Excel crashes

我有一个宏(附加代码),它将来自两个 sheet 的数据写入两个变体数组。然后它使用嵌套循环在第一个 sheet.

中的一条数据上查找第二个 sheet 中的所有可能匹配项

当找到第一个匹配项时,其中一个变体数组似乎被擦除,我得到 'Subscript out of range'。当正在比较数据时,或者当我随后由于找到匹配项而尝试将数据从该数组传递到另一个过程时,可能会发生这种情况。

当我查看 Locals window 时,这个数组可以从显示存储值变为在每个索引中包含错误消息 "Application-defined or object-defined error",或者根本没有索引,或者索引具有高负数。

无论如何,如果我在代码处于调试模式时尝试进一步调查,Excel 会崩溃 ("Excel has encountered a problem and needs to close")。

我听从了 link 中的建议: http://exceleratorbi.com.au/excel-keeps-crashing-check-your-vba-code/

...但无济于事。

我已经单步执行了代码并且可以将其跟踪到被测试的数据值第一次匹配。每次我 运行.

时,相同的索引(相同的 i 和 j 值)都会发生这种情况

我在办公室网络上使用 Excel 2013。

任何人都可以告诉我可能导致此问题的原因,或者我可以执行任何测试来帮助缩小原因范围吗?
可能是由于内存使用?阵列的尺寸约为 15000 x 11 和 4000 x 6,较小的是 corrupted/failing.

Sub classTest()
Dim i As Long, j As Long
Dim CK_Array() As Variant, RL_Array() As Variant

Dim wb As Workbook
Dim CK_Data As Worksheet, RL_Data As Worksheet

Set wb = ThisWorkbook
Set CK_Data = wb.Sheets(1)
Set RL_Data = wb.Sheets(2)

Call getRange_BuildArray(CK_Array, CK_Data)
Call getRange_BuildArray(RL_Array, RL_Data) ' this sets the array that gets corrupted. 

For i = 2 To UBound(CK_Array)
    If Not IsEmpty(CK_Array(i, 6)) Then
        For j = 2 To UBound(RL_Array)
            If CK_Array(i, 6) = RL_Array(j, 4) Then  ' array gets corrupted here or line below        
Call matchFound(dResults, CStr(CK_Array(i, 1) & " | " & CK_Array(i, 5)), CStr(RL_Array(j, 2) & " " & RL_Array(j, 3)), CStr(RL_Array(j, 1)), CStr(RL_Array(1, 3)))   ' or array gets corrupted here
            End If
        Next j
    End If
Next i

End Sub


Private Sub getRange_BuildArray(arr As Variant, ws As Worksheet)

Dim endR As Long, endC As Long
Dim rng As Range

endR = ws.UsedRange.Rows.Count
endC = ws.UsedRange.Columns.Count

Set rng = Range(ws.Cells(1, 1), ws.Cells(endR, endC))
arr = rng

End Sub

编辑: 根据此处的要求,是匹配找到的 Sub 的代码。它是一个字典,在一个集合中包含 class 个对象。因此,我还在下面发布了 class 代码。我还没有使用所有 class 属性和方法,因为这个问题已经停止了我的测试。

 Sub matchFound(dictionary As Object, nameCK As String, nameRL As String, RLID As String, dataitem As String)

Dim cPeople As Collection
Dim matchResult As CmatchPerson

    If dictionary.exists(nameCK) Then
        Set matchResult = New CmatchPerson
            matchResult.Name = nameRL
            matchResult.RLID = RLID
            matchResult.matchedOn = dataitem
            dictionary.Item(nameCK).Add matchResult
    Else
        Set cPeople = New Collection
        Set matchResult = New CmatchPerson
            matchResult.Name = nameRL
            matchResult.RLID = RLID
            matchResult.matchedOn = dataitem
            cPeople.Add matchResult
        dictionary.Add nameCK, cPeople
    End If
End Sub

Class

Option Explicit
Private pName As String
Private pRLID As String
Private pMatchedOn As String

Public Property Get Name() As String
Name = pName
End Property

Public Property Let Name(Name As String)
pName = Name
End Property

Public Property Get RLID() As String
RLID = pRLID
End Property

Public Property Let RLID(ID As String)
pRLID = ID
End Property

Public Property Get matchedOn() As String
matchedOn = pMatchedOn
End Property

Public Property Let matchedOn(textString As String)
pMatchedOn = textString
End Property

Public Sub MatchedOnString(datafield As String)
Dim text As String
text = Me.matchedOn & "|" & datafield
Me.Name = text
End Sub

我找到了导致问题的代码行。但是,我无法解释为什么它一定会导致崩溃,所以我希望能提供其他关于为什么会发生这种情况的意见。

将 RL 和 CK 数组传递给 getRange_Build 数组子时,我省略了将这些变量表示为数组的括号。

代码是这样的...

Call getRange_BuildArray(CK_Array, CK_Data)
Call getRange_BuildArray(RL_Array, RL_Data)

...但应该是这样的

Call getRange_BuildArray(CK_Array(), CK_Data)
Call getRange_BuildArray(RL_Array(), RL_Data)

我在想这没有被标记为编译错误的原因是因为 getRange_BuildArray 过程中的相关参数本身也缺少表示数组的必要括号。

就是这个...

Private Sub getRange_BuildArray(arr As Variant, ws As Worksheet)

...应该是这个

Private Sub getRange_BuildArray(arr() As Variant, ws As Worksheet)

有了这些更改,宏就可以针对整个数据集成功完成,不会导致 excel 崩溃。

如前所述,如果有人可以更详细地说明这是如何导致 excel 崩溃的,那就太好了。

我已将您的问题简化为最小、可验证和完整的示例。

当您将范围的隐式默认值分配给作为 Variant 数组传递的 Variant 变量时,会出现问题。

Sub VariantArrayWTF()

  Dim aBar() As Variant
  Dim aFoo() As Variant

  GetArray aBar
  GetArray aFoo

  Debug.Print aBar(1, 1)
  'aFoo() has now lost it's `+` sign in Locals window, but the bounds are still visible

  Debug.Print aBar(1, 1)
  'aFoo() has now lost its bounds in Locals Window

  'aFoo(1,1) will produce subscript out of range
  'Exploring the Locals Window, incpsecting variables, will crash Excel
  Debug.Print aFoo(1, 1)

End Sub

Sub GetArray(ByRef theArray As Variant)
  'Note the use of theArray instead of theArray()

  'Implicitly calling the default member is problematic
  theArray = Sheet1.UsedRange

End Sub

有许多解决方法 - 我建议使用 两者:

使用显式调用`Range.Value`

您甚至可以显式调用默认成员 Range.[_Default]。确切的方法并不重要,但必须明确。

Sub GetArray(ByRef theArray As Variant)
  theArray = Sheet1.UsedRange.Value
End Sub

避免使用 `Call`,并传递常见的 Variant 定义

  • Call 是弃用语句,可以省略。
  • 一致地声明数组和辅助函数的数组参数。也就是说,在所有情况下使用 (),或 none.

请注意声明 Dim aFoo() As Variant 和声明 Dim aFoo As Variant 之间的区别,后者是一个可以 包含 数组的变体。

带括号

Sub VariantArrayWTF()

  Dim aBar() As Variant
  Dim aFoo() As Variant

  GetArray aBar
  GetArray aFoo

  Debug.Print aBar(1, 1)
  Debug.Print aBar(1, 1)
  Debug.Print aFoo(1, 1)

End Sub

Sub GetArray(ByRef theArray() As Variant)
  theArray = Sheet1.UsedRange
End Sub

没有括号

Sub VariantArrayWTF()

  Dim aBar As Variant
  Dim aFoo As Variant

  GetArray aBar
  GetArray aFoo

  Debug.Print aBar(1, 1)
  Debug.Print aBar(1, 1)
  Debug.Print aFoo(1, 1)

End Sub

Sub GetArray(ByRef theArray As Variant)
  theArray = Sheet1.UsedRange
End Sub