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