Почему крэш вложенного массива лучше, когда он достигает верхнего предела? - PullRequest
Новая
       36

Почему крэш вложенного массива лучше, когда он достигает верхнего предела?

1 голос
/ 26 октября 2019

У меня есть следующий код, который дает сбой Excel при запуске: 

Option Explicit

Private Type Calculations
    x As Double
    x2 As Double
    x3 As Double
    x4 As Double
    x5 As Double
    h1 As Double
    v1 As Double
    a1 As Double
    p1 As Double
    h2 As Double
    v2 As Double
    a2 As Double
    p2 As Double
    h3 As Double
    v3 As Double
    a3 As Double
    p3 As Double
    h4 As Double
    v4 As Double
    a4 As Double
    p4 As Double
    h5 As Double
    v5 As Double
    a5 As Double
    p5 As Double
End Type

Private Type Points
    Point() As Calculations
End Type

Private Type Sections
    Section() As Points
End Type

Function DynamicRedim()

    Dim aSections As Sections
    Dim aCalculations As Calculations
    Dim aPoints() As Points

    Dim i As Integer

    Dim aSectionsDimension As Integer
    Dim aPointsDimension As Integer

    Dim aSectionsCount As Integer
    Dim aPointsCount As Integer


    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    aSectionsDimension = 1
    aPointsDimension = 5


    ReDim Preserve aSections.Section(aSectionsDimension)

    aPoints = aSections.Section()
    ReDim Preserve aPoints(aPointsDimension)

    For i = LBound(aSections.Section) To UBound(aSections.Section)
        aSections.Section(i).Point = aPoints
    Next

    For aSectionsCount = LBound(aSections.Section) To UBound(aSections.Section) '<< believe crash occurs when aSectionsCount = UBound(aSections.Section)?????
        For aPointsCount = LBound(aSections.Section(aSectionsCount).Point) To UBound(aSections.Section(aSectionsCount).Point)
            aSections.Section(aSectionsCount).Point(aPointsCount).x = 0
            aSections.Section(aSectionsCount).Point(aPointsCount).x2 = 0
            aSections.Section(aSectionsCount).Point(aPointsCount).x3 = 0
            aSections.Section(aSectionsCount).Point(aPointsCount).x4 = 0
            aSections.Section(aSectionsCount).Point(aPointsCount).x5 = 0
            aSections.Section(aSectionsCount).Point(aPointsCount).h1 = 0
            aSections.Section(aSectionsCount).Point(aPointsCount).v1 = 0
            aSections.Section(aSectionsCount).Point(aPointsCount).a1 = 0
            aSections.Section(aSectionsCount).Point(aPointsCount).p1 = 0
            aSections.Section(aSectionsCount).Point(aPointsCount).h2 = 0
            aSections.Section(aSectionsCount).Point(aPointsCount).v2 = 0
            aSections.Section(aSectionsCount).Point(aPointsCount).a2 = 0
            aSections.Section(aSectionsCount).Point(aPointsCount).p2 = 0
            aSections.Section(aSectionsCount).Point(aPointsCount).h3 = 0
            aSections.Section(aSectionsCount).Point(aPointsCount).v3 = 0
            aSections.Section(aSectionsCount).Point(aPointsCount).a3 = 0
            aSections.Section(aSectionsCount).Point(aPointsCount).p3 = 0
            aSections.Section(aSectionsCount).Point(aPointsCount).h4 = 0
            aSections.Section(aSectionsCount).Point(aPointsCount).v4 = 0
            aSections.Section(aSectionsCount).Point(aPointsCount).a4 = 0
            aSections.Section(aSectionsCount).Point(aPointsCount).p4 = 0
            aSections.Section(aSectionsCount).Point(aPointsCount).h5 = 0
            aSections.Section(aSectionsCount).Point(aPointsCount).v5 = 0
            aSections.Section(aSectionsCount).Point(aPointsCount).a5 = 0
            aSections.Section(aSectionsCount).Point(aPointsCount).p5 = 0
        Next
    Next

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True

End Function

Я добавил вложенные циклы for к концу функции, чтобы обнулить все элементы в типе. Прежде чем я добавил этот шаг, я заметил, что элементы в конце (то есть v4, a4, p4, h4, v5, a5, p5, h5) каким-то образом оказались с действительно странными значениями - случайными числами для питания e-211.

Очевидно, что я не устанавливал эти значения, но в равной степени я тоже не хочу их !!

Кроме этого, код также не должен аварийно завершать работу ... Я вполне уверен, что это происходит тогда, когда внешний цикл for достигает UBound(aSections.Section).

Я не вижу причин, почему это могло бы сделать это. Я пробовал два отдельных компьютера, чтобы устранить любые проблемы, связанные с компьютером, и похоже, что это связано с кодом.

Может кто-нибудь предложить решение для этого?

1 Ответ

0 голосов
/ 27 октября 2019

Point и Points являются классами Excel. Всегда плохая идея использовать имя типа данных Excel в качестве имени одной из ваших переменных. Однако я не верю, что это является причиной сбоя.

DynamicRedim не возвращает значение, поэтому это Sub, а не Function. Это не важно, поскольку вы не пытаетесь вернуть значение.

Я считаю, что первая проблема:

aPoints = aSections.Section()

Оба aPoints и aSections.Section()являются массивами точек, но они определяются по-разному. Я подозреваю, что выравнивание немного отличается, и память повреждена.

Я полагаю, что такое же повреждение памяти происходит с: 

For i = LBound(aSections.Section) To UBound(aSections.Section)
  aSections.Section(i).Point = aPoints
Next

Когда я делаю один шаг по вашему коду, Excel падает на полпутивниз по первой петле. Можно получить адрес переменной Excel, чтобы мы могли провести подробное исследование и доказать, что проблема в поврежденной памяти, но я не думаю, что это стоило бы времени.

Ваша проблема в том, что вы пытаетесьПереопределить массив, скопировав в него предопределенный массив. Я успешно скопировал массивы, но исходные и конечные массивы имеют одинаковое определение. Вы не можете переопределить массив массивов обычным способом, но вы можете переопределить aSections.Section (i) .Point.

Я переписал ваш код, чтобы он работал. Я включил объяснение каждого из моих изменений. Вернитесь с вопросами, если эти объяснения не являются адекватными. 

Option Explicit

Private Type Calculations
    x As Double
    x2 As Double
    x3 As Double
    x4 As Double
    x5 As Double
    h1 As Double
    v1 As Double
    a1 As Double
    p1 As Double
    h2 As Double
    v2 As Double
    a2 As Double
    p2 As Double
    h3 As Double
    v3 As Double
    a3 As Double
    p3 As Double
    h4 As Double
    v4 As Double
    a4 As Double
    p4 As Double
    h5 As Double
    v5 As Double
    a5 As Double
    p5 As Double
End Type

' Every use of "Point" replaced by "Pnt" to avoid any conflict
' with Excel classes Point and Points
Private Type Pnts
    Pnt() As Calculations
End Type

Private Type Sections
    Section() As Pnts
End Type
Function DynamicRedim2()

    Dim aSections As Sections
    'Dim aCalculations As Calculations    ' Not used by this code
    'Dim aPoints() As Points              ' Not used by this code

    Dim i As Integer

    Dim aSectionsDimension As Integer
    Dim aPntsDimension As Integer

    Dim aSectionsCount As Integer
    Dim aPntsCount As Integer

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    aSectionsDimension = 1
    aPntsDimension = 5

    ' Removed Preserve because nothing to preserve
    ReDim aSections.Section(aSectionsDimension)

    ' Use ReDim to size array rather than copying array of correct size
    ' Note: if "aSections.Section(i)" was an array, you cannot ReDim
    ' in this way because the syntax is invalid. You must pass
    ' "aSections.Section(i)" to a subroutine which can ReDim it.  If this
    ' in not clear, I will construct an example to show what I mean.
    For i = LBound(aSections.Section) To UBound(aSections.Section)
      ReDim aSections.Section(i).Pnt(aPntsDimension)
    Next

    ' Display aSections to show already initialised to zeros.  VBA initialises
    ' all variables to a default value.
    Call DsplSection(aSections)

    For aSectionsCount = LBound(aSections.Section) To UBound(aSections.Section)
        For aPntsCount = LBound(aSections.Section(aSectionsCount).Pnt) To _
                         UBound(aSections.Section(aSectionsCount).Pnt)
            ' I have changed the zeros to non-zero values to prove the code is
            ' changing all the elements.
            ' "1" is stored as an Integer and will have to be converted to a Double
            ' for each statement for each loop. "1#" tells the compiler to store 1
            ' as a Double.
            aSections.Section(aSectionsCount).Pnt(aPntsCount).x = 1#
            aSections.Section(aSectionsCount).Pnt(aPntsCount).x2 = 2#
            aSections.Section(aSectionsCount).Pnt(aPntsCount).x3 = 3#
            aSections.Section(aSectionsCount).Pnt(aPntsCount).x4 = 4#
            aSections.Section(aSectionsCount).Pnt(aPntsCount).x5 = 5#
            aSections.Section(aSectionsCount).Pnt(aPntsCount).h1 = 6#
            aSections.Section(aSectionsCount).Pnt(aPntsCount).v1 = 7#
            aSections.Section(aSectionsCount).Pnt(aPntsCount).a1 = 8#
            aSections.Section(aSectionsCount).Pnt(aPntsCount).p1 = 9#
            aSections.Section(aSectionsCount).Pnt(aPntsCount).h2 = 10#
            aSections.Section(aSectionsCount).Pnt(aPntsCount).v2 = 11#
            aSections.Section(aSectionsCount).Pnt(aPntsCount).a2 = 12#
            aSections.Section(aSectionsCount).Pnt(aPntsCount).p2 = 13#
            aSections.Section(aSectionsCount).Pnt(aPntsCount).h3 = 14#
            aSections.Section(aSectionsCount).Pnt(aPntsCount).v3 = 15#
            aSections.Section(aSectionsCount).Pnt(aPntsCount).a3 = 16#
            aSections.Section(aSectionsCount).Pnt(aPntsCount).p3 = 17#
            aSections.Section(aSectionsCount).Pnt(aPntsCount).h4 = 18#
            aSections.Section(aSectionsCount).Pnt(aPntsCount).v4 = 19#
            aSections.Section(aSectionsCount).Pnt(aPntsCount).a4 = 20#
            aSections.Section(aSectionsCount).Pnt(aPntsCount).p4 = 21#
            aSections.Section(aSectionsCount).Pnt(aPntsCount).h5 = 22#
            aSections.Section(aSectionsCount).Pnt(aPntsCount).v5 = 23#
            aSections.Section(aSectionsCount).Pnt(aPntsCount).a5 = 24#
            aSections.Section(aSectionsCount).Pnt(aPntsCount).p5 = 25#
        Next
    Next

    ' Display new values
    Call DsplSection(aSections)

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True

End Function
Sub DsplSection(ByRef SectionCrnt As Sections)

  ' For VBA, "Integer" specifies a 16-bit integer while "Long" defines a
  ' 32-bit integer. Integer variable are supposed to take longer to process
  ' than Long variable on 32-bit and 64-bit computers.  VBA routines are
  ' difficult to time because of all the background processing that can occur
  ' at any time. My experiments have failed to detect any difference between
  ' Integer and Long variables. However, no harm in having the bigger variable.
  Dim InxS As Long
  Dim InxP As Long

  For InxS = LBound(SectionCrnt.Section) To UBound(SectionCrnt.Section)
    For InxP = LBound(SectionCrnt.Section(InxS).Pnt) To _
               UBound(SectionCrnt.Section(InxS).Pnt)
      Debug.Print InxS & " " & InxP & ": ";
      ' Note how much typing you save using a With statement
      With SectionCrnt.Section(InxS).Pnt(InxP)
        Debug.Print .x & " " & .x2 & " " & .x3 & " " & .x4 & " " & .x5 & " " & _
                    .h1 & " " & .v1 & " " & .a1 & " " & .p1 & " " & .h2 & " " & _
                    .v2 & " " & .a2 & " " & .p2 & " " & .h3 & " " & .v3 & " " & _
                    .a3 & " " & .p3 & " " & .h4 & " " & .v4 & " " & .a4 & " " & _
                    .p4 & " " & .h5 & " " & .v5 & " " & .a5 & " " & .p5
      End With
    Next
  Next

End Sub
...