变体数组已被损坏'运行宏时 - Excel崩溃

时间:2016-01-22 16:08:27

标签: excel vba excel-vba crash

我有一个宏(附加代码),它将两张数据写入两个变量数组。然后,它使用嵌套循环在第一张纸上的第二张纸上查找所有可能的匹配。

当找到第一个匹配项时,其中一个变体数组似乎被擦除,而我的下标超出范围'。这可能发生在比较数据时,或者我随后尝试将数据从该数组传递到另一个程序,因为找到了匹配项。

当我查看Locals窗口时,此数组可以从显示存储的值变为具有错误消息"应用程序定义的错误或对象定义的错误"在每个索引中,或根本没有索引,或具有高负数的索引。

无论如何,如果我在代码处于调试模式时尝试进一步调查,Excel会崩溃(" Excel遇到问题并需要关闭")。

我已按照此链接的建议: http://exceleratorbi.com.au/excel-keeps-crashing-check-your-vba-code/

......但无济于事。

我已经逐步完成了代码,并且可以在第一次测试的数据值匹配时进行跟踪。每次运行时都会发生相同的索引(相同的i和j值)。

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

任何人都可以告诉我可能导致此问题或我可以执行的任何测试以帮助缩小原因吗? 可能是因为内存使用?这些阵列的大小约为15000 x 11和4000 x 6,它是较小的一个被破坏/失败的阵列。

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

编辑: 这里要求的是matchfound Sub的代码。它是一个字典,它将类对象保存在集合中。因此我也在下面发布了类代码。我还没有使用所有的类属性和方法,因为这个问题已经停止了我的测试。

 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

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

2 个答案:

答案 0 :(得分:3)

我已将您的问题减少到最低,可验证和完整的示例。

将范围的隐式默认值分配给作为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`,并传递常见的变体定义

  • Call是不推荐使用的声明,可以省略。
  • 声明数组和辅助函数'数组参数一致。也就是说,在所有实例中使用(),或者没有。

请注意声明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

答案 1 :(得分:0)

我找到了引起问题的代码行。但是,我无法解释为什么它会导致崩溃,所以我会很感激为什么会发生这种情况的其他意见。

当将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崩溃。

如上所述,如果有人可以提供更详细的细节分析,那将会很棒。