3
\$\begingroup\$

I'm working on a large project that requires a ton of data to be processed. I was thinking that using classes would be the best way, and it is, until it has to dump out the memory at the end of every process I start.

The code for this project is large, but I uplodaded a file with only the necessary means to test my current problem, the destroying time of a lot of objects created by my process.

The example in my code outputs this:

job time: 17008,5989ms.

total time: 85488,3443ms.

The difference between the job time and the total time is just before the Set class = nothing and after.

Sub RecargaProgramaciones()

    AhorroMemoria True
    Dim Temporizador As New aTimer
    Temporizador.StartCounter
    Dim MiClase As New Programaciones
    MiClase.CargaDatosAgentes
    Debug.Print "job time: " & Temporizador.TimeElapsed & "ms."
    Set MiClase = Nothing
    AhorroMemoria False
    Debug.Print "total time: " & Temporizador.TimeElapsed & "ms."

End Sub

Am I using classes correctly? Should I rebuild this in any other way to avoid this dumping time?

I'd appreciate any help with this because is driving me crazy and execution time is important.

Here the link to download the file.

Edit: The sub above calls this class, named Programaciones(forecast) which has this code:

Option Explicit
Private m_Modo As Dictionary
Private Property Get Modos(ByVal Key As String) As Modos
    With m_Modo
        If Not .Exists(Key) Then .Add Key, New Modos
    End With
    Set Modos = m_Modo(Key)
End Property
Private Sub Class_Initialize()
    Set m_Modo = New Dictionary
End Sub
Private Sub Class_Terminate()
    Set m_Modo = Nothing
End Sub
Private Property Get Keys() As Variant
    Keys = m_Modo.Keys
End Property
Public Sub CargaDatosAgentes()

    Horarios
    MisModos

End Sub
Private Sub Horarios()

    With ThisWorkbook.Sheets("Base Acc")
        Dim arr As Variant: arr = .UsedRange.Value
        Dim ColAgente As Long: ColAgente = .Rows(1).Find("ORIGEN", LookAt:=xlWhole).Column + 1
    End With

    Dim i As Long
    Dim j As Long
    For i = 2 To UBound(arr)
        For j = ColAgente To UBound(arr, 2)
            If arr(i, j) Like "*:*" Then
                CargaTramos arr, i, j
            End If
        Next j
    Next i
    Erase arr

End Sub
Private Sub CargaTramos(arr As Variant, i As Long, j As Long)

    Dim fecha As Date: fecha = arr(1, j)

    Dim MiFecha As Fechas

    Dim Saltar As Boolean
    If Month(arr(1, j)) <> Month(arr(1, UBound(arr, 2))) Then Saltar = True
    Dim arrHorario As Variant: arrHorario = Split(arr(i, j), "/")
    Dim HoraI As Date
    Dim HoraF As Date

    Dim y As Long
    Dim x As Long
    Dim Hora As String
    Dim Modo As String
    Dim DesfaseI As Byte
    Dim DesfaseF As Byte
    Dim DesfasadoI As Boolean
    Dim DesfasadoF As Boolean
    Dim Minutos As Byte
    For y = LBound(arrHorario) To UBound(arrHorario)
        DesfasadoI = False
        DesfasadoF = False
        HoraI = Left(Trim(arrHorario(y)), 5)
        HoraF = Right(Trim(arrHorario(y)), 5)
        If Minute(HoraI) < 30 And Minute(HoraI) > 0 Then
            DesfaseI = 30 - Minute(HoraI)
            HoraI = TimeSerial(Hour(HoraI), 0, 0)
            DesfasadoI = True
        ElseIf Minute(HoraI) > 30 And Minute(HoraI) < 60 Then
            DesfaseI = 60 - Minute(HoraI)
            HoraI = TimeSerial(Hour(HoraI), 30, 0)
            DesfasadoI = True
        End If
        If Minute(HoraF) < 30 And Minute(HoraF) > 0 Then
            DesfaseF = Minute(HoraF)
            HoraF = TimeSerial(Hour(HoraF), 0, 0)
            DesfasadoF = True
        ElseIf Minute(HoraF) > 30 And Minute(HoraF) < 60 Then
            DesfaseF = Minute(HoraF) - 30
            HoraF = TimeSerial(Hour(HoraF), 30, 0)
            DesfasadoF = True
        End If
        If HoraF = "00:00:00" Then HoraF = "23:30:00"
        If HoraF < HoraI Then HoraF = HoraF + 1
        For x = 0 To DateDiff("n", HoraI, HoraF) / 30 - 1
            If DesfasadoI And x = 0 Then
                Minutos = DesfaseI
            ElseIf DesfasadoF And x = DateDiff("n", HoraI, HoraF) / 30 - 1 Then
                Minutos = DesfaseF
            Else
                Minutos = 30
            End If
            Hora = Format(HoraI + TimeSerial(0, x * 30, 0), "hh:mm")
            If Hora < HoraI Then
                Saltar = False
                fecha = arr(1, j) + 1
                If Month(fecha) <> Month(arr(1, UBound(arr, 2))) Then Saltar = True
            End If
            If Saltar Then GoTo SiguienteTramo
            Set MiFecha = Modos(arr(i, 7)).Centros(arr(i, 4)).Fechas(fecha)
            If arr(i, 7) = "Plani" Then 'Como el horario se solapa con el de ACC, restamos el tiempo a los de ACC
                If Modos("ACC").Centros(arr(i, 4)).Fechas(fecha).Tramos(Hora).Agentes(arr(i, 3)).Presentes = Minutos Then
                    Modos("ACC").Centros(arr(i, 4)).Fechas(fecha).Tramos(Hora).BorrarAgente arr(i, 3)
                End If
            End If
            MiFecha.Tramos(Hora).Agentes(arr(i, 3)).Presentes = Minutos
SiguienteTramo:
        Next x
    Next y

End Sub
Private Sub MisModos()


    Dim arr As Variant: arr = ThisWorkbook.Sheets("Mapa Habilidades").UsedRange.Value
    Dim Encabezados As New Dictionary
    Dim MisAgentes As New Dictionary
    Dim i As Long

    For i = 2 To UBound(arr)
        MisAgentes.Add arr(i, 1) & arr(i, 6), i
    Next i
    For i = 7 To UBound(arr, 2)
        Encabezados.Add arr(1, i), i
    Next i
    CargaModosTramos arr, MisAgentes, Encabezados
    m_Modo.Remove "ACC"
    m_Modo.Remove "Plani"
    Erase arr

End Sub
Private Sub CargaModosTramos(arr As Variant, MisAgentes As Dictionary, Encabezados As Dictionary)

    Dim Modo As Variant
    Dim centro As Variant
    Dim fecha As Variant
    Dim tramo As Variant
    Dim agente As Variant
    Dim MiModo As String
    For Each Modo In m_Modo.Keys
        If Not Modo = "ACC" And Not Modo = "Plani" Then GoTo SiguienteModo
        For Each centro In Modos(Modo).Keys
            For Each fecha In Modos(Modo).Centros(centro).Keys
                For Each tramo In Modos(Modo).Centros(centro).Fechas(fecha).Keys
                    For Each agente In Modos(Modo).Centros(centro).Fechas(fecha).Tramos(tramo).Keys
                        MiModo = CalculaModo(arr, MisAgentes, Encabezados, agente & Modo, fecha)
                        Modos(MiModo).Centros(centro).Fechas(fecha).Tramos(tramo).Agentes(agente).Presentes = _
                            Modos(Modo).Centros(centro).Fechas(fecha).Tramos(tramo).Agentes(agente).Presentes
                            Modos(Modo).Centros(centro).Fechas(fecha).Tramos(tramo).BorrarAgente agente
                    Next agente
                Next tramo
            Next fecha
        Next centro
SiguienteModo:
    Next Modo

End Sub
Private Function CalculaModo(arr As Variant, MisAgentes As Dictionary, Encabezados As Dictionary, agente As Variant, fecha As Variant) As String
    Dim i As Long: i = MisAgentes(agente)
    Dim j As Long: j = Encabezados(CDate(fecha))
    CalculaModo = arr(i, j)
End Function

The above class host another one called Modos(Services) with the following code:

Option Explicit
Private m_Centro As Dictionary
Public Property Get Centros(ByVal Key As String) As Centros
    With m_Centro
        If Not .Exists(Key) Then .Add Key, New Centros
    End With
    Set Centros = m_Centro(Key)
End Property
Private Sub Class_Initialize()
    Set m_Centro = New Dictionary
End Sub
Private Sub Class_Terminate()
    Set m_Centro = Nothing
End Sub
Public Property Get Keys() As Variant
    Keys = m_Centro.Keys
End Property
Public Sub BorrarModo()
    m_Centro.RemoveAll
End Sub
Public Sub BorrarCentro(centro As Variant)
    m_Centro.Remove CStr(centro)
End Sub

The above class hosts anothe class called Centros(Locations) with this code:

Option Explicit
Private m_NombrePlantilla As String
Private m_Fecha As Dictionary
Private m_Porcentaje As Dictionary
Public Property Get Fechas(ByVal Key As String) As Fechas
    With m_Fecha
        If Not .Exists(Key) Then .Add Key, New Fechas
    End With
    Set Fechas = m_Fecha(Key)
End Property
Public Property Get Porcentajes(ByVal Key As String) As Porcentajes
    With m_Porcentaje
        If Not .Exists(Key) Then .Add Key, New Porcentajes
    End With
    Set Porcentajes = m_Porcentaje(Key)
End Property
Private Sub Class_Initialize()
    Set m_Fecha = New Dictionary
    Set m_Porcentaje = New Dictionary
End Sub
Private Sub Class_Terminate()
    Set m_Fecha = Nothing
    Set m_Porcentaje = Nothing
End Sub
Public Property Get Keys() As Variant
    Keys = m_Fecha.Keys
End Property
Public Property Get NombrePlantilla() As String
    NombrePlantilla = m_NombrePlantilla
End Property
Public Property Let NombrePlantilla(param As String)
    m_NombrePlantilla = param
End Property
Public Property Get ExistePorcentaje(KPI As String) As Boolean
    If m_Porcentaje.Exists(KPI) Then ExistePorcentaje = True
End Property
Public Sub BorrarFecha(fecha As Variant)
    m_Fecha.Remove CStr(fecha)
End Sub

Centros hosts the next class which is Fechas(Dates) with the following code:

Option Explicit
Private m_Fecha As Dictionary
Public Property Get Fechas(ByVal Key As String) As Fechas
    With m_Fecha
        If Not .Exists(Key) Then .Add Key, New Fechas
    End With
    Set Fechas = m_Fecha(Key)
End Property
Private Sub Class_Initialize()
    Set m_Fecha = New Dictionary
End Sub
Private Sub Class_Terminate()
    Set m_Fecha = Nothing
End Sub
Public Property Get Keys() As Variant
    Keys = m_Fecha.Keys
End Property

Fecha hosts another class called Tramo(intervals) which has this code:

Option Explicit
Private m_Tramo As Dictionary
Private m_Horario As String
Public Property Get Tramos(ByVal Key As String) As Tramos
    With m_Tramo
        If Not .Exists(Key) Then .Add Key, New Tramos
    End With
    Set Tramos = m_Tramo(Key)
End Property
Private Sub Class_Initialize()
    Set m_Tramo = New Dictionary
End Sub
Private Sub Class_Terminate()
    Set m_Tramo = Nothing
End Sub
Public Property Get Keys() As Variant
    Keys = m_Tramo.Keys
End Property
Public Property Get Horario() As String
    Horario = m_Horario
End Property
Public Property Let Horario(param As String)
    m_Horario = param
End Property
Public Sub BorrarTramo(tramo As Variant)
    m_Tramo.Remove CStr(tramo)
End Sub

Finally, Tramos hosts the last class, Agentes(Agents) with this code:

Option Explicit
Private m_Agente As Dictionary
Property Get Agentes(ByVal Key As String) As Agentes
    With m_Agente
        If Not .Exists(Key) Then .Add Key, New Agentes
    End With
    Set Agentes = m_Agente(Key)
End Property
Private Sub Class_Initialize()
    Set m_Agente = New Dictionary
End Sub
Private Sub Class_Terminate()
    Set m_Agente = Nothing
End Sub
Public Property Get Keys() As Variant
    Keys = m_Agente.Keys
End Property

The code for the class Agentes is this:

Option Explicit
Private m_Presentes As Long
Public Property Get Presentes() As Long
    Presentes = m_Presentes
End Property
Public Property Let Presentes(param As Long)
    m_Presentes = m_Presentes + param
End Property

What this is doing is basically, going to the sheet BaseACC and fill for every worker and every day at what intervals is present. It's doing this under the temporal services (ACC/Plani).

After this, goes to the sheet Mapa Habilidades and checks if it`s ACC/Plani to adjust the presents to the services that can be found on that sheet.

This is just the loadup for the next steps. But I feel that if I could build this someway better when the whole process ends won't take forever to purge the memory, or worse, run out of memory.

\$\endgroup\$
5
  • \$\begingroup\$ Your data seems pivoted, with lots of data duplicated everywhere. You would need much fewer iterations and objects with normalized data. Avoid declaring anything As New, that runs the Initialize handler in a not-necessarily expected way. Also Set thing = Nothing is nuking your auto-instantiated object, but then if you do Debug.Print miClase Is Nothing it will print False and have re-created the internal dictionary, because of the As New. Never declare things As New when you want to control when objects live and die. \$\endgroup\$ Jun 10 '20 at 13:27
  • \$\begingroup\$ @MathieuGuindon I don't actually have data duplicated if you mean on my sheets. If not, Could you elaborate that? Also, what is the difference between Dim X As Object and Set X = New Object and Dim X As New Object? \$\endgroup\$
    – Damian
    Jun 10 '20 at 14:23
  • 1
    \$\begingroup\$ I haven't looked in details, but looking at the worksheet the date columns should not be columns but rows; there should be a Date column with the date, and then one other column to hold the data for that date - that's what pivoted means =) as for the implications of As New, see Rubberduck \$\endgroup\$ Jun 10 '20 at 14:39
  • \$\begingroup\$ @MathieuGuindon I get the pivoted now... But I would trade the iterations in the column for more iterations in rows, right? Would that improve anything? If so is a good tip, but still won't change my problem... I'd really appreaciate if you had the time to look throughly into my test workbook. \$\endgroup\$
    – Damian
    Jun 10 '20 at 14:54
  • 1
    \$\begingroup\$ @MathieuGuindon you were right, transposing the Dates to a single column spared me like 70s on execution time! That's something :) \$\endgroup\$
    – Damian
    Jun 11 '20 at 10:43

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.