改進VBA，它過濾當前月份 月份到年末的資料透視表欄位

我有一個 VBA 宏可以按如下方式過濾資料透視表：它需要當前月份 剩余月份直到年底，包括一年的最后一個月（12 月）。目前一切正常。但是，當我將 12 月作為當前月份時出現錯誤：它不會取消過濾上個月 - 11 月，因此我制作了一個“錯誤處理程式”，從 11 月洗掉過濾器。

我相信有一種方法可以改進這一點并使代碼更簡單。但是我找不到如何做到這一點的方法。如果您有任何建議/想法如何使此代碼更簡單，我將不勝感激！

代碼如下：

Sub FilterMonth()
Dim mthname, m As Integer
    mNum = 12 'Format(Date, "m")
    mName = Array("", "Jan", "Feb", "Mar", "Apr", "May", "Jun", _
                        "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
                        
    If mNum = 12 Then
        On Error GoTo errhandler
        For i = mNum To LBound(mName) Step -1
            mPast = mName(i   1)
            ThisWorkbook.Sheets("SCC").PivotTables("SCC").PivotFields("Period") _
            .PivotItems(mPast).Visible = False
        Next i
        
errhandler:
    ThisWorkbook.Sheets("SCC").PivotTables("SCC").PivotFields("Period") _
    .PivotItems("Nov").Visible = False
    Resume Next
    
    Else
    
        For i = mNum To LBound(mName)   1 Step -1
            mPast = mName(i)
            ThisWorkbook.Sheets("SCC").PivotTables("SCC").PivotFields("Period") _
            .PivotItems(mPast).Visible = False
        Next i
    
        For n = mNum To UBound(mName)
            mNow = mName(n)
            ThisWorkbook.Sheets("SCC").PivotTables("SCC").PivotFields("Period") _
            .PivotItems(mNow).Visible = True
        Next n
        
    End If
    
End Sub

uj5u.com熱心網友回復：

嘗試類似下面的代碼，代碼注釋中的 fins 解釋：

Option Explicit


Sub FilterMonth()


Dim mthname As String
Dim mName As Variant
Dim i As Long, MatchRow As Variant, MonthsClearArr() As String


Application.ScreenUpdating = False

'    mNum = 12 'Format(Date, "m")
    mthname = "Dec"  ' <-- for testing purposes
    mName = Array("", "Jan", "Feb", "Mar", "Apr", "May", "Jun", _
                        "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
                        
    ' remove all filters from Pivot field
    ThisWorkbook.Sheets("SCC").PivotTables("SCC").PivotFields("Period").ClearAllFilters
          
    ' Use Match to get the Month Numner inside the array
    MatchRow = Application.Match(mthname, mName, 0)
    
    If Not IsError(MatchRow) Then
        ' save all month names to save in an array
        ReDim MonthsClearArr(1 To MatchRow - 1)
        For i = 1 To MatchRow - 1
            MonthsClearArr(i) = mName(i - 1)
        Next i
        
        ' loop over ne array of months to hide, and per month hide
        For i = 1 To UBound(MonthsClearArr)
            On Error Resume Next
            ThisWorkbook.Sheets("SCC").PivotTables("SCC").PivotFields("Period") _
            .PivotItems(MonthsClearArr(i)).Visible = False
            On Error GoTo 0
        Next i
   
    Else ' error finding Month Name
        ' display error message
    
    End If

Application.ScreenUpdating = True

                 
End Sub

此外，最好設定所有物件，包括 Pivot-Table 和 Pivot-Field：

Dim PvtTbl As PivotTable
Dim PvtFld As PivotField

' set the Pivot-Table object
Set PvtTbl = ThisWorkbook.Sheets("SCC").PivotTables("SCC")
Set PvtFld = PvtTbl.PivotFields("Period")

uj5u.com熱心網友回復：

我假設您想隱藏過去幾個月并顯示當前和未來

Sub FilterMonth()

    Dim mthname, m As Integer, ws As Worksheet
    mNum = 6 'Format(Date, "m")
    mName = Array("", "Jan", "Feb", "Mar", "Apr", "May", "Jun", _
                      "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
                        
    Set ws = ThisWorkbook.Sheets("SCC")
    With ws.PivotTables("SCC").PivotFields("Period")
        For i = 1 To 12
            .PivotItems(mName(i)).Visible = CBool(i >= mNum)
        Next
    End With
    
End Sub

標籤：擅长 vba

上一篇：凍結Highchart影片

下一篇：取消保護指定路徑中的Excel作業簿并重繪作業簿連接，然后保護作業簿