Question

所有

我在另一个子功能的循环中调用此子功能。循环很好，没有这个子调用。当我调用这个sub时，它工作正常一次，然后，在第二次，我得到一个＆＃34;运行时错误5 - 无效的过程调用或参数＆＃34;这里。

我有很多床单，每张都有一张桌子。我想用数据透视表来总结每个表。

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
    tblnm, Version:=xlPivotTableVersion10).CreatePivotTable _
    TableDestination:=dest, TableName:=pivnm, _
    DefaultVersion:=xlPivotTableVersion10

您可以在下面看到整个子功能。

Sub PIVOT()
Dim pivnm, shtnm, tblnm, dest As String
Application.EnableEvents = False

shtnm = ActiveSheet.Name
tblnm = Range("N2").Value 'I have previously sent the table name to this cell
pivnm = tblnm & " PIVOT"
tblnm = Replace(tblnm, " ", "_") 
'The tables are named with underscores, but were stored with spaces

Range("N3") = pivnm
With Range("N3") 'simply wraps the text in the cell
    .HorizontalAlignment = xlGeneral
    .VerticalAlignment = xlBottom
    .WrapText = True
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
End With

dest = shtnm & "!R1C15" 'sets the destination

    Sheets(shtnm).Select
    Range("C1").Select 
    'the following was written using the macro recorder, with names replaced by
    'variables
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        tblnm, Version:=xlPivotTableVersion10).CreatePivotTable _
        TableDestination:=dest, TableName:=pivnm, _
        DefaultVersion:=xlPivotTableVersion10
    Sheets(shtnm).Select
    Cells(1, 15).Select
    With ActiveSheet.PivotTables(pivnm).PivotFields("Process text")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables(pivnm).AddDataField ActiveSheet.PivotTables( _
        pivnm).PivotFields("Process text"), "Count of Process text", xlCount
    ActiveSheet.PivotTables(pivnm).AddDataField ActiveSheet.PivotTables( _
        pivnm).PivotFields("Column1"), "Sum of Column1", xlSum
    With ActiveSheet.PivotTables(pivnm).DataPivotField
        .Orientation = xlColumnField
        .Position = 1
    End With

    With ActiveSheet.PivotTables(pivnm).PivotFields("Process text")
        .Orientation = xlRowField
        .Position = 1
    End With

shtnm = vbNullString 'I tried resetting everything. Didn't work
tblnm = vbNullString
pivnm = vbNullString
dest = vbNullString

End Sub

如果我遗漏了任何信息或者有什么我可以做得更好的话，请告诉我！

我被要求附加其他功能的循环 - 所以这里......除了我之外，对任何人来说可能看起来很荒谬......

While count3 <= count2
    DoEvents
    Application.StatusBar = "Updating. Sheet " & (count3) & " of 61 complete."
    Sheets("Sheet2").Select
    Selection.AutoFilter Field:=2
    Selection.AutoFilter Field:=2, Criteria1:=Range("O" & CStr(count3)).Value
    Range("A1:M" & CStr(count)).Select
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.count)
    ActiveSheet.Paste
    If Range("B2") <> "" Then

        ActiveSheet.Name = Range("B2")
        tblnm = Range("B2").Value
        Sheets(tblnm).Select

        Application.StatusBar = "Making Table" & (count3) & " of 61 complete."

        While Range("B" & CStr(count4 + 1)) <> ""
            count4 = count4 + 1
        Wend

        Range("N1").Value = count4

        DataArea = ("$A$1:$M$" & count4)
        DataArea1 = DataArea

        ActiveWorkbook.ActiveSheet.ListObjects.Add(xlSrcRange, Range(DataArea1), , xlYes).Name = _
            tblnm
        ActiveWorkbook.ActiveSheet.ListObjects(tblnm).Range.AutoFilter Field:=5, Criteria1:= _
            "=*UF_*", Operator:=xlAnd, Criteria2:="<>*Drive*"
        ActiveSheet.ListObjects(tblnm).Range.AutoFilter Field:=8, Criteria1:= _
            "<>#VALUE!", Operator:=xlAnd
        ActiveWorkbook.Worksheets(tblnm).ListObjects(tblnm).Sort.SortFields.Add Key _
            :=Range("M1:M" & CStr(count4)), SortOn:=xlSortOnValues, Order:=xlDescending, _
            DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets(tblnm).ListObjects(tblnm).Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
        End With

        Call RhidRow

        Columns("A:A").EntireColumn.Hidden = True
        Columns("B:B").EntireColumn.Hidden = True
        Columns("F:F").EntireColumn.Hidden = True
        Columns("G:G").EntireColumn.Hidden = True
        Columns("H:H").EntireColumn.Hidden = True
        Columns("I:I").EntireColumn.Hidden = True
        Columns("J:J").EntireColumn.Hidden = True
        Columns("K:K").EntireColumn.Hidden = True
        Columns("L:L").EntireColumn.Hidden = True
        Columns("C:C").EntireColumn.AutoFit
        Columns("D:D").EntireColumn.AutoFit
        Columns("E:E").EntireColumn.AutoFit
        Columns("M:M").EntireColumn.AutoFit

        While Range("M" & CStr(count5 + 1)) <> ""
            count5 = count5 + 1
        Wend

        Range("N2") = tblnm
        With Range("N2")
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        End With

        Call PIVOT
    Else
        ActiveSheet.Delete
    End If
    Range("A1").Select
    count3 = count3 + 1
    count4 = 2
    count6 = 2
Wend

Answer 1

如果您的工作表名称中包含空格，则需要：

dest = "'" & shtnm & "'!R1C15"

这是未经测试的，但是作为传递参数的想法：

Sub PIVOT(tblnm As String, ws As Worksheet)
    Dim pivnm                       As String
    Dim shtnm                       As String
    Dim dest                        As String
    Dim PT                          As PivotTable
    Application.EnableEvents = False

    With ws
        shtnm = "'" & .Name & "'"
        pivnm = tblnm & " PIVOT"
        tblnm = Replace(tblnm, " ", "_")
        'The tables are named with underscores, but were stored with spaces


        With .Range("N3")
            .Value = pivnm
            'simply wraps the text in the cell
            .HorizontalAlignment = xlGeneral
            .VerticalAlignment = xlBottom
            .WrapText = True
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
    End With

    dest = shtnm & "!R1C15"    'sets the destination

    'the following was written using the macro recorder, with names replaced by
    'variables
    Set PT = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
                                               tblnm, Version:=xlPivotTableVersion10).CreatePivotTable( _
                                               TableDestination:=dest, TableName:=pivnm, _
                                               DefaultVersion:=xlPivotTableVersion10)

    With PT
        With .PivotFields("Process text")
            .Orientation = xlRowField
            .Position = 1
        End With
        .AddDataField .PivotFields("Process text"), "Count of Process text", xlCount
        .AddDataField .PivotFields("Column1"), "Sum of Column1", xlSum
        With .DataPivotField
            .Orientation = xlColumnField
            .Position = 1
        End With

        With .PivotFields("Process text")
            .Orientation = xlRowField
            .Position = 1
        End With
    End With

End Sub

并且调用代码将使用类似：

Call PIVOT(tblnm, wks)

其中wks是一个工作表变量，设置为具有数据的工作表。

VBA - 在循环中创建数据透视表时的无效过程

1 个答案: