All geek questions in one place

Variant array corrupted when running macro - Excel crashes

I have a macro (attached code) that writes data from two sheets into two variants of arrays. Then it uses a nested loop to search for all possible matches in the second sheet on the piece of data in the 1st sheet.

When the first match is found, one of the options for the arrays seems to be wiped off, and I get "Subtitle out of range". this can happen when the data is compared or when I subsequently try to transfer data from this array to another procedure as a result of a match.

When I look in the Locals window, this array can change from showing saved values ​​that have the error message "Application-undefined or object, specific errors" in each index, or no indexes at all, or indexes with high negative numbers.

No matter if I try to continue researching while the code is in debug mode, Excel will crash ("Excel has encountered a problem and needs to close").

I followed advice on this link: http://exceleratorbi.com.au/excel-keeps-crashing-check-your-vba-code/

... but to no avail.

I went through the code and can trace it for the first time when the compared data values ​​are compared. This happens for the same indexes (same values ​​of i and j) every time I run.

I am using Excel 2013 in our office network.

- , , , ?
? 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

EDIT: 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
+4
2

, .

, 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 `+` 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 - .
  • . use() none.

Dim aFoo() As Variant, , Dim aFoo As 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


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
+3

, . , , , , .

RL CK getRange_Build Array , .

...

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.

0

Source: https://habr.com/ru/post/1625531/

More articles:


All Articles