[求助]数据透视表筛选代码错在哪里?

L2MINGJING

各位老师:

   附件是本人所写的用inputbox函数筛选数据透视表的代码,  但蓝色粗字部份出现1004错误, 请老师指点代码应如何更改?

Private Sub 查询批号4()
    Dim box As String, arr() As String
    Dim i As Integer, r As Integer, n As Integer
    box = InputBox("请输入要查询的批号")
    If box = "" Then Exit Sub
    Application.ScreenUpdating = False
    Sheets("生产进度总表").Activate
    r = 0
    With Sheets("生产进度总表").PivotTables("数据透视表1").PivotFields("批号")
        n = .pivotitems.Count
        For i = 1 To n
            If .pivotitems(i).Name <> box Then
                r = r + 1
                ReDim Preserve arr(1 To r) As String
                arr(r) = .pivotitems(i).Name
            End If
        Next
        .pivotitems(box).Visible = True
        .pivotitems(arr).Visible = False
    End With
    Application.ScreenUpdating = True
   
End Sub

谢谢

nrvv8tjl.rar (36.81 KB, 下载次数: 11)

2007-12-3 08:20 上传

点击文件名下载附件
[求助]数据透视表筛选代码错在哪里?

BobPan

PivotItems(Index) 好像不接受数组,只有一个一个隐藏

L2MINGJING

各位老师:

    如何一个个的隐藏,代码运行要很长的计算时间,有无其它办法. 请高手指点.?

谢谢

BobPan

好像关闭自动计算也无计于事！关注！

L2MINGJING

各位老师:

  我试写了以下代码,但运行速度特慢, 比我们直接在数据透视中的下拉键中选择要慢几十倍,请高手指点代码??

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

DJFN

换一个思路呢
Private Sub 查询批号4()
    Dim box As String, arr() As String
    Dim c As Range
    Dim i As Integer, r As Integer, n As Integer
   
    Rows("6:3000").Hidden = False

    box = InputBox("请输入要查询的批号")
    If box = "" Then Exit Sub

    Sheets("生产进度总表").Activate
       Set c = [a:a].Find(box, LookIn:=xlValues, LookAt:=xlWhole)
      s = c.MergeArea.Address
      Rows("6:3000").Hidden = True
      Range(s).EntireRow.Hidden = False
   
End Sub

L2MINGJING

楼上老师:

     多谢你的回复，但是效果 还是不太理想,  上述代码只能用隐藏行的方法来隐藏数据。一但更改数据透视表的格式，就没有不能显示相关的信息了。

还望高手再指点！

谢谢

L2MINGJING

版主们:

     看来只能求助你们了, 难道真没得解了吗?  希望能听你们的评说!!!!

谢谢

BobPan

通过数据透视表应该没有更好的办法，不过关注，期待高手出现！！！

L2MINGJING

期待高手出现!