[求助]数据透视表筛选代码优化

L2MINGJING

各位老师:

     附件是本人所写的用INPUTBOX 对话框筛选数据透视表, 特请高手指点代码应如何优化?

 

谢谢

 

Sub 查询批号()
    box = Val(InputBox("请输入要查询的批号"))
    Application.ScreenUpdating = False
    countax = Application.WorksheetFunction.CountIf(Sheets("生产进度总表").Range("R2:R" & Sheets("生产进度总表").Range("R65536").End(xlUp).Row), box)
    If countax = 0 Then
        MsgBox "你所输入的批号不存在"
        Exit Sub
    End If
    For a = 2 To Sheets("生产进度总表").Range("R65536").End(xlUp).Row
        With Sheets("生产进度总表").PivotTables("数据透视表1").PivotFields("批号")
            If Sheets("生产进度总表").Range("R" & a).Value = box Then
                If .pivotitems("" & Sheets("生产进度总表").Range("R" & a).Value & "").Visible = False Then
                    .pivotitems("" & Sheets("生产进度总表").Range("R" & a).Value & "").Visible = True
                End If
            Else
                If Err.Number = 0 Then h = a
                On Error Resume Next
                If .pivotitems("" & Sheets("生产进度总表").Range("R" & a).Value & "").Visible = True Then
                    .pivotitems("" & Sheets("生产进度总表").Range("R" & a).Value & "").Visible = False
                End If
            End If
        End With
    Next a
    If h > 0 Then
        With Sheets("生产进度总表").PivotTables("数据透视表1").PivotFields("批号")
            .pivotitems("" & Sheets("生产进度总表").Range("R" & h).Value & "").Visible = False
        End With
    End If
    Application.ScreenUpdating = True
   
End Sub

paLd1tGF.rar (25.51 KB, 下载次数: 19)

2007-11-29 15:34 上传

点击文件名下载附件
[求助]数据透视表筛选代码优化

L2MINGJING

高手们:

     敬请赐教!!!

谢谢

L2MINGJING

各位老师:

    我试着又更改了一下代码, 但是运行的速度比手工在数据透视表的筛选键的选择要慢的得多,因程序要每条数据进行重新计算,用录制宏方法,亦无法找到相关的代码. 特请老师们指点.

希望有高手能不吝赐教!!!!

Sub 查询批号2()
    Dim  a As Integer
    box = InputBox("请输入要查询的批号")
    If box = "" Then Exit Sub
    Application.ScreenUpdating = False
    Sheets("生产进度总表").Activate
    Dim n
    With Sheets("生产进度总表").PivotTables("数据透视表1")
        For a = 1 To .PivotFields("批号").pivotitems.Count
            If .PivotFields("批号").pivotitems(a).Name = box Then
                If .PivotFields("批号").pivotitems(a).Visible = False Then .PivotFields("批号").pivotitems(a).Visible = True
                n = n + 1
            Else
                On Error Resume Next
                If .PivotFields("批号").pivotitems(a).Visible = True Then .PivotFields("批号").pivotitems(a).Visible = False
                If Err.Number = 1004 Then h = a
            End If
               
        Next
        .PivotFields("批号").pivotitems(h).Visible = False
    End With
   
    If n = 0 Then MsgBox "你所输入的批号不存在"
    Application.ScreenUpdating = True
   
End Sub