如何使用VBA更改,如果一个Excel文件是可见的(最小化)基于更改数据透视表中的总和?



我在Excel中有一个实时报告,显示起重机当前是否延迟。我想做的是,通过使用VBA,是为了使它,当起重机开始延迟,或结束一个,文件将从最小化到被扩展,以便用户可以被信号,当起重机已经走了延迟。我还希望这种情况只发生在经过过滤后出现在表中的起重机上。

我附上了数据的图像以及起重机的相关过滤器。使用起重机滤波器的起重机延迟数据

我的想法是扫描Grand Total列,如果值从空变为大于0的数字(反之亦然),则触发一个宏,使文件可见。

如果可能的话,我需要使用什么代码,我该如何去做?

许多谢谢。

对于那些感兴趣的人,我想出了一个解决方案。如果你想让我讨论一下,请留下评论。代码如下:

Option Explicit
Private Sub Worksheet_PivotTableAfterValueChange(ByVal TargetPivotTable As PivotTable, ByVal TargetRange As Range)
End Sub
Public Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Dim pt As PivotTable
Dim wsBackup As Worksheet
Dim c As Range
Dim rngPivot As Range
Dim lastCol As Long
Dim strCrane As String
Dim sValues As Variant
sValues = ArrayListOfSelectedAndVisibleSlicerItems("Slicer_QC1")
'Change to suit
Set pt = Me.PivotTables("PivotTable1")
'Where has a copy of table been saved?
Set wsBackup = ThisWorkbook.Worksheets("Pivot Copy")
Set rngPivot = pt.DataBodyRange
'How many columns?
lastCol = rngPivot.Columns.Count
Application.ScreenUpdating = False
'Check each cell in last column/grand total
For Each c In rngPivot.Columns(lastCol).Cells
'What item is this?
strCrane = c.Offset(0, -lastCol).Value

'Escape clause
If strCrane = "Grand Total" Then Exit For
If c.Value = 0 Then
'Use a function that won't throw an error
'Note we add 1 to account for row labels
If WorksheetFunction.SumIfs(wsBackup.Columns(1 + lastCol), _
wsBackup.Range("A:A"), strCrane) <> 0 Then
If IsInArray(strCrane, sValues) = True Then
ActiveWindow.WindowState = xlMaximized
MsgBox strCrane & " has ended a delay" & vbCrLf & vbCrLf & "(Minimise Excel after using file)"

End If
End If
ElseIf c.Value > 0 Then
If WorksheetFunction.SumIfs(wsBackup.Columns(1 + lastCol), _
wsBackup.Range("A:A"), strCrane) = 0 Then
If IsInArray(strCrane, sValues) = True Then

ActiveWindow.WindowState = xlMaximized
MsgBox strCrane & " has started a delay" & vbCrLf & vbCrLf & "(Minimise Excel after using file)"

End If
End If
End If
Next c
'Save our new backup
wsBackup.Cells.Clear
pt.TableRange2.Copy
wsBackup.Range("A1").PasteSpecial xlPasteValues
'Clean up
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Function ArrayListOfSelectedAndVisibleSlicerItems(MySlicerName As String) As Variant
'This function returns an array of the limited set of items in Slicer A
'Limitation is due to both:
'(1) direct selection of items by user in slicer A
'(2) selection of items in slicer B which in consequence limits the number of items in slicer A
Dim ShortList() As Variant
Dim i As Integer: i = 0 'for iterate
Dim sC As SlicerCache
Dim sI As SlicerItem 'for iterate
Set sC = ThisWorkbook.SlicerCaches(MySlicerName)
For Each sI In sC.SlicerItems
If sI.Selected = True Then
' Debug.Print sI.Name
ReDim Preserve ShortList(i)
ShortList(i) = sI.Value
i = i + 1
End If
Next sI
ArrayListOfSelectedAndVisibleSlicerItems = ShortList
End Function
Private Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
IsInArray = UBound(Filter(arr, stringToBeFound)) > -1
End Function

最新更新