Quantcast
Channel: Active questions tagged excel - Stack Overflow
Viewing all articles
Browse latest Browse all 88868

Memory problem when filtering an OLAP cube

$
0
0

So I have a macro that for starters needs to open a file and filter the OLAP cube with some dates. Performing this actions burns a lot of memory, going from 100Mb to 1,5Gb.

That's a problem because later I'm gonna fill with a lot of data my classes and might raise the out of memory error.

The thing is that I can't seem to clear the memory in any way because it is not occupying that bunch because of some store object, just because it is filtering the cube.

Does anyone how to solve this? I've tried saving the workbook, even stoping the macro and saving the workbook won't solve this.

the Main sub:

Option Explicit
Sub Main()

    Dim MisDatos As New España

    MisDatos.CargaReales


End Sub

The class doing the work:

Option Explicit
Private m_Login As Object
Property Get Logins(ByVal Key As String) As Logins
    With m_Login
        If Not .Exists(Key) Then .Add Key, New Logins
    End With
    Set Logins = m_Login(Key)
End Property
Private Sub Class_Initialize()
    Set m_Login = CreateObject("Scripting.Dictionary")
End Sub
Private Sub Class_Terminate()
    Set m_Login = Nothing
End Sub
Public Property Get Keys() As Variant
    Keys = m_Login.Keys
End Property
Public Property Get Count() As Long
    Count = m_Login.Count
End Property
Public Sub CargaReales()

    Dim wb As Workbook
    Set wb = Workbooks.Open("C:\Users\USER\Desktop\Adherencia\España\BI KronosReporting.xlsb", False, True)

    Dim ArrayFechasFiltrado As Variant
    ArrayFechasFiltrado = CargaFechasFiltrado
    FiltrarTablaReales wb, ArrayFechasFiltrado
    Erase ArrayFechasFiltrado

    Dim arrReales As Variant
    arrReales = wb.Sheets(1).UsedRange.Value
    wb.Close False
    Set wb = Nothing

End Sub
Private Function CargaFechasFiltrado() As Variant

    Dim Festivos As Object
    Set Festivos = CargaFestivos

    'Vamos a cargar las fechas que necesitaremos para cargar los fichajes en un array
    With ThisWorkbook.Sheets("Main")

        Dim FechaI As Date
        FechaI = Left(.Cells(1, 2), 10) 'Fecha Inicio

        Dim FechaF As Date
        FechaF = Right(.Cells(1, 2), 10) 'Fecha Fin

        ReDim arr(Day(FechaI) To Day(FechaF) - Festivos.Count) As String 'Declaramos un array del tamaño de los días necesarios

        Dim Fecha As Date
        Dim i As Long
        Dim x As Long: x = Day(FechaI)
        For i = Day(FechaI) To Day(FechaF) 'hacemos un bucle para meter dichos días en el array
            Fecha = DateSerial(Year(FechaI), Month(FechaI), i)
            If Not Festivos.Exists(Fecha) Then
                arr(x) = "[Fecha Trabajo].[Fecha Trabajo].[Día del Mes].&["& Format(Fecha, "yyyymmdd") & "]"
                x = x + 1
            End If
        Next i
    End With

    CargaFechasFiltrado = arr

End Function
Private Function CargaFestivos() As Object

    'Cargamos los festivos en un diccionario
    Dim Diccionario As Object: Set Diccionario = CreateObject("Scripting.Dictionary")
    With ThisWorkbook.Sheets("Main")
        Dim lrow As Long
        lrow = .Cells(.Rows.Count, "D").End(xlUp).Row
        If lrow > 2 Then
            Dim i As Long
            For i = 3 To lrow
                Diccionario.Add .Cells(i, 4).Value, 1
            Next i
            Set CargaFestivos = Diccionario
        Else
            Set CargaFestivos = Nothing
        End If
    End With

End Function
Private Sub FiltrarTablaReales(wb As Workbook, arr As Variant)

    wb.SlicerCaches("SegmentaciónDeDatos_Fecha_Trabajo.Fecha_Trabajo").VisibleSlicerItemsList = arr

End Sub

It is the last sub, FiltrarTablaReales which is filling the memory. As you can see there are no objects but an array later on emptied(which can't consume that much of memory because it's 1 to 31 at max).

Any thoughts?


Viewing all articles
Browse latest Browse all 88868


<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>