运行宏时变量数组“损坏”-Excel崩溃

Mar*_*k W 4 crash excel vba excel-vba

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

找到第一个匹配项后,其中一个变体数组似乎被擦除了,并且出现“下标超出范围”。当比较数据时,或者由于发现匹配项而我随后尝试将数据从该数组传递到另一个过程时,可能会发生这种情况。

当我在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
Run Code Online (Sandbox Code Playgroud)

编辑:根据要求,这里是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
Run Code Online (Sandbox Code Playgroud)

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
Run Code Online (Sandbox Code Playgroud)

Thu*_*ame 5

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

当您将范围的隐式默认值分配给作为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
Run Code Online (Sandbox Code Playgroud)

有多种解决方法-建议同时使用以下两种方法

使用对`Range.Value`的显式调用

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

Sub GetArray(ByRef theArray As Variant)
  theArray = Sheet1.UsedRange.Value
End Sub
Run Code Online (Sandbox Code Playgroud)

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

  • Call 是已弃用的语句,可以省略。
  • 一致地声明数组和辅助函数的数组参数。也就是说,在所有实例中都使用(),或者不使用。

请注意Dim aFoo() As Variant,声明Dim aFoo As Variant哪个是Variant 数组和声明哪个是可以包含数组的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
Run Code Online (Sandbox Code Playgroud)

没有括号

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
Run Code Online (Sandbox Code Playgroud)