检查 PowerPivot 内存占用,适用 Excel 2013。
Option Explicit
Sub 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.Close
ExitPoint:
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
Set rs = Nothing
Exit Sub
ErrHandler:
MsgBox "An error occured - " & Err.Description, vbOKOnly
Resume ExitPoint
End Sub