Массив Для броска l oop объекта переменная или переменная блока не установлена - PullRequest
0 голосов
/ 31 марта 2020

Итак, у меня есть этот код, который устанавливает свойства объекта класса в для l oop, сохраняя каждый объект как элемент в массиве, BREobjects (). Следующий код приведен ниже, и первые BREobjects (i) .BREdays выдают

Ошибка переменной объекта не установлена.

Это массив Publi c, поэтому это не должно быть переделано или что-то еще. Кто-нибудь знает, что происходит?

Код, который устанавливает свойства объекта:

'creates a new object for each BRE day/time combination
count = 0
For Each i In BREitems
    BREdaysString = Split(Cells(i.Row, "c").value, ", ")
    For j = LBound(BREdaysString) To UBound(BREdaysString)

        count = count + 1
        ReDim Preserve BREobjects(count)
        Set BREobjects(count) = New BREpptObjects

        BREobjects(count).BREname = Cells(i.Row, "a").value
        BREobjects(count).BREcategory = Cells(i.Row, "b").value
        BREobjects(count).BREstartTime = Cells(i.Row, "d").value
        BREobjects(count).BRElength = Cells(i.Row, "e").value
        BREobjects(count).BREtimeRight = Right(Cells(i.Row, "d").value, 2)

        BREobjects(count).BREdays = BREdaysString(j)

        'Sets the start row number accounting for BREs that start on the half hour
        If BREobjects(count).BREtimeRight = 0 Then
            BREobjects(count).BREstartRow = (Cells(i.Row, "d").value / 100) + 3
            BREobjects(count).BREremainder = 0
        ElseIf BREobjects(count).BREtimeRight <> 0 Then
            BREobjects(count).BREstartRow = ((Cells(i.Row, "d").value - BREobjects(count).BREtimeRight) / 100) + 3
            BREobjects(count).BREremainder = 1
        End If

        'determines the row the BRE ends in
        If BREobjects(count).BRElength - Fix(BREobjects(count).BRElength) = 0 Then
            BREobjects(count).BREendRow = BREobjects(count).BREstartRow + BREobjects(count).BRElength - 1
        ElseIf BREobjects(count).BRElength - Fix(BREobjects(count).BRElength) > 0 Or BREobjects(count).BREremainder = 1 Then
            BREobjects(count).BREendRow = BREobjects(count).BREstartRow + Fix(BREobjects(count).BRElength)
        End If

        If BREobjects(count).BREremainder = 1 And BREobjects(count).BRElength >= 1 Then
            BREobjects(count).BREendRow = BREobjects(count).BREendRow + 1
        End If

        'sets the end time
        If BREobjects(count).BRElength - Fix(BREobjects(count).BRElength) = 0 Then
            BREobjects(count).BREendTime = BREobjects(count).BREstartTime + (100 * BREobjects(count).BRElength)
        ElseIf BREobjects(count).BRElength - Fix(BREobjects(count).BRElength) > 0 Then
            BREtimeRight = Right(BREobjects(count).BRElength, 2)
            BREobjects(count).BREendTime = BREobjects(count).BREstartTime + (100 * Fix(BREobjects(count).BRElength)) + (BREtimeRight * 60)
        End If

        BREobjects(count).BREID = BREobjects(count).BREname & " " & BREobjects(count).BREdays & " " & _
        BREobjects(count).BREstartTime & " " & BREobjects(count).BREendTime & " " & BREobjects(count).BRElength
    Next j
    Erase BREdaysString
Next i

'This loop throws an Object variable or with block variable not set error.
'Thrown on the array in the line BREdays = BREobjects(i).BREdays.  
Back:
For i = LBound(BREobjects) To UBound(BREobjects)
    Dim BREdays As String

    BREdays = BREobjects(i).BREdays

    If FiveDay = True And BREdays = "Saturday" Or BREdays = "Sunday" Then
        Call DeleteElement(i, BREobjects())                         'Deletes the BREppt Object from the BREobjects array
        ReDim Preserve BREobjects(UBound(BREobjects) - 1)           'Shrinks the array by one, removing the last one
        GoTo Back                                                   'Restarts the loop because the UBound has changed
    End If
    Debug.Print BREobjects(i).BREID
Next i

1 Ответ

0 голосов
/ 01 апреля 2020

Если бы вы провели рефакторинг своего кода с использованием коллекции и перенесли некоторые настройки свойств в модуль класса, это могло бы уменьшить код до чего-то подобного.

Sub ExportToPPTButton_Click()

    Dim wb As Workbook, ws As Worksheet, iLastRow As Long
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Sheet1")

    iLastRow = ws.Cells(Rows.count, 1).End(xlUp).Row

    Dim BREobjects As New Collection
    Dim obj As BREpptObjects2, arDays As Variant
    Dim i As Long, dow As Variant, sKey As String, s As String
    Dim FiveDays As Boolean

    ' dictionary to count multiple day/time
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

    FiveDays = True
    For i = 5 To iLastRow
        s = ws.Cells(i, "D")
        s = Replace(s, " ", "") 'remove spaces
        arDays = Split(s, ",")

        For Each dow In arDays
           s = LCase(Left(dow, 3))
           If (FiveDays = True) And (s = "sat" Or s = "sun") Then
              ' skip weekends
           Else
              Set obj = New BREpptObjects2
              obj.BREDays = dow
              obj.initialise ws.Cells(i, 1)

              ' avoid duplicate day/time
              sKey = obj.BREDays & obj.BREstartTime
              obj.BREpic = dict(sKey) + 0
              dict(sKey) = dict(sKey) + 1

              ' add to collection
              BREobjects.Add obj, obj.BREID
           End If
       Next
    Next

    ' set total objects in cell
    For Each obj In BREobjects
        sKey = obj.BREDays & obj.BREstartTime
        obj.BREobjInCell = dict(sKey)
    Next

    MsgBox BREobjects.count & " objects added to collection"
    For Each obj In BREobjects
        obj.dump ' debug.print objects
    Next

End Sub

Примечание: я использовал Publi c здесь для демонстрации, но используйте Private в вашем коде


' class BREpptObjects2
Public BREname As String, BRElocation As String, BREcategory As String
Public BREstartTime As String, BREendTime As String
Public BRElength As Double
Public BREDays As String, BREID As String, BREStartRow, BREEndRow
Public BREobjInCell As Integer, BREpic As Integer

Sub initialise(rng As Range)

    Dim StartHour As Integer, StartMin As Integer
    Dim DurHour As Integer, DurMin As Integer
    Dim EndHour As Integer, EndMin As Integer
    With rng
        BREname = .Offset(0, 0).Value ' A
        BRElocation = .Offset(0, 1).Value 'B
        BREcategory = .Offset(0, 2).Value 'C
        BREstartTime = .Offset(0, 4).Value 'E
        BRElength = .Offset(0, 5).Value 'F
    End With

    StartHour = Int(BREstartTime / 100)
    StartMin = BREstartTime Mod 100
    DurHour = Fix(BRElength)
    DurMin = (BRElength - DurHour) * 60

    ' set end time
    EndHour = StartHour + DurHour
    EndMin = StartMin + DurMin
    If EndMin > 60 Then
       EndMin = EndMin - 60
       EndHour = EndHour + 1
    End If
    BREendTime = EndHour * 100 + EndMin

    'Sets the start row number accounting for BREs that start on the half hou
    BREStartRow = StartHour + 3
    BREEndRow = EndHour + 3

    BREID = BREname & " " & BREDays & " " & _
            BREstartTime & " " & BREendTime & " " & BRElength

End Sub

Sub dump()
      Debug.Print "ID [" & BREID & "]"
      Debug.Print "StartTime", BREstartTime, "End TIme", BREendTime, "Length", BRElength
      Debug.Print "StartRow", BREStartRow, "EndRow", BREEndRow
      Debug.Print "pic", BREpic, "objInCell", BREobjInCell
End Sub

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...