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)
我已将您的问题简化为最小,可验证和完整的示例。
当您将范围的隐式默认值分配给作为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.[_Default]。确切的方法并不重要,但必须明确。
Sub GetArray(ByRef theArray As Variant)
theArray = Sheet1.UsedRange.Value
End Sub
Run Code Online (Sandbox Code Playgroud)
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)
| 归档时间: |
|
| 查看次数: |
543 次 |
| 最近记录: |