Excel 2013 - PowerPivot 内存检查
检查 PowerPivot 内存占用，适用 Excel 2013。
Option ExplicitSub GetMemoryUsage() Dim wbTarget As Workbook Dim ws As Worksheet Dim rs As Object Dim lRows As Long Dim lRow As Long Dim sReportName As String Dim sQuery As String sReportName = "Memory_Usage" 'Suppress alerts and screen updates With Application .ScreenUpdating = False .DisplayAlerts = False End With 'Bind to active workbook Set wbTarget = ActiveWorkbook 'Check if a worksheet already exists Err.Clear On Error Resume Next Set ws = wbTarget.Worksheets(sReportName) If Err.Number = 0 Then 'Worksheet found If MsgBox("A memory usage sheet workbook is already detected, " & _ "do you want to remove the existing one and continue?", vbYesNo) = vbYes Then ws.Delete Else GoTo ExitPoint End If End If On Error GoTo ErrHandler 'Make sure the model is loaded wbTarget.Model.Initialize 'Send query to the model sQuery = "SELECT dimension_name, attribute_name, DataType,(dictionary_size/1024) AS dictionary_size " & _ "FROM $system.DISCOVER_STORAGE_TABLE_COLUMNS " & _ "WHERE dictionary_size > 0" Set rs = CreateObject("ADODB.Recordset") rs.Open sQuery, wbTarget.Model.DataModelConnection.ModelConnection.ADOConnection lRow = rs.RecordCount If lRow > 0 Then 'Add report worksheet Set ws = wbTarget.Worksheets.Add With ws .Name = sReportName .Range("A1").FormulaR1C1 = "Table" .Range("B1").FormulaR1C1 = "Column" .Range("C1").FormulaR1C1 = "DataType" .Range("D1").FormulaR1C1 = "MemorySize (KB)" lRows = 2 rs.MoveFirst Do While Not rs.EOF 'Add the data to the rows .Range("A" & lRows).FormulaR1C1 = rs("dimension_name") .Range("B" & lRows).FormulaR1C1 = rs("attribute_name") .Range("C" & lRows).FormulaR1C1 = rs("DataType") .Range("D" & lRows).FormulaR1C1 = rs("dictionary_size") lRows = lRows + 1 rs.movenext Loop 'Format the Memory Size field .Columns("D:D").NumberFormat = "#,##0.00" 'Create table .ListObjects.Add(xlSrcRange, .Range("$A$1:$D$" & lRow + 1), , xlYes).Name = "MemorySizeTable" End With 'Create PivotTable wbTarget.PivotCaches.Create(SourceType:=xlDatabase, _ SourceData:="MemorySizeTable", _ Version:=xlPivotTableVersion15).CreatePivotTable _ TableDestination:="Memory_Usage!R2C7", _ TableName:="MemoryTable", _ DefaultVersion:=xlPivotTableVersion15 'Modify the PivotTable With ws With .PivotTables("MemoryTable") With .PivotFields("Table") .Orientation = xlRowField .Position = 1 .AutoSort xlDescending, "Sum of MemorySize (KB)" End With With .PivotFields("Column") .Orientation = xlRowField .Position = 2 .AutoSort xlDescending, "Sum of MemorySize (KB)" End With .AddDataField .PivotFields("MemorySize (KB)"), "Sum of MemorySize (KB)", xlSum .PivotFields("Table").AutoSort xlDescending, "Sum of MemorySize (KB)" .PivotFields("Column").AutoSort xlDescending, "Sum of MemorySize (KB)" End With 'Format the Memory Size field in the PivotTable .Columns("H:H").NumberFormat = "#,##0.00" 'Add conditional formatting With .Range("H3") .FormatConditions.AddDatabar .FormatConditions(.FormatConditions.Count).ShowValue = True .FormatConditions(.FormatConditions.Count).SetFirstPriority With .FormatConditions(1) .MinPoint.Modify newtype:=xlConditionValueAutomaticMin .MaxPoint.Modify newtype:=xlConditionValueAutomaticMax With .BarColor .Color = 13012579 .TintAndShade = 0 End With .BarFillType = xlDataBarFillGradient .Direction = xlContext .NegativeBarFormat.ColorType = xlDataBarColor .BarBorder.Type = xlDataBarBorderSolid .NegativeBarFormat.BorderColorType = xlDataBarColor With .BarBorder.Color .Color = 13012579 .TintAndShade = 0 End With .AxisPosition = xlDataBarAxisAutomatic With .AxisColor .Color = 0 .TintAndShade = 0 End With With .NegativeBarFormat.Color .Color = 255 .TintAndShade = 0 End With With .NegativeBarFormat.BorderColor .Color = 255 .TintAndShade = 0 End With .ScopeType = xlSelectionScope .ScopeType = xlFieldsScope End With End With With .Range("H4") .FormatConditions.AddDatabar .FormatConditions(.FormatConditions.Count).ShowValue = True .FormatConditions(.FormatConditions.Count).SetFirstPriority With .FormatConditions(1) .MinPoint.Modify newtype:=xlConditionValueAutomaticMin .MaxPoint.Modify newtype:=xlConditionValueAutomaticMax With .BarColor .Color = 15698432 .TintAndShade = 0 End With .BarFillType = xlDataBarFillGradient .Direction = xlContext .NegativeBarFormat.ColorType = xlDataBarColor .BarBorder.Type = xlDataBarBorderSolid .NegativeBarFormat.BorderColorType = _ xlDataBarColor With .BarBorder.Color .Color = 15698432 .TintAndShade = 0 End With .AxisPosition = xlDataBarAxisAutomatic With .AxisColor .Color = 0 .TintAndShade = 0 End With With .NegativeBarFormat.Color .Color = 255 .TintAndShade = 0 End With With .NegativeBarFormat.BorderColor .Color = 255 .TintAndShade = 0 End With .ScopeType = xlSelectionScope .ScopeType = xlFieldsScope End With End With 'Collapse the PivotTable .PivotTables("MemoryTable").PivotFields("Table").ShowDetail = False 'Set selection to top .Range("MemorySizeTable[[#Headers],[Table]]").Select End With Else MsgBox "No model available", vbOKOnly End If rs.CloseExitPoint: With Application .ScreenUpdating = True .DisplayAlerts = True End With Set rs = Nothing Exit SubErrHandler: MsgBox "An error occured - " & Err.Description, vbOKOnly Resume ExitPointEnd Sub