VBA将切片器添加到未指定的表

Question

我已经创建了一个宏，它可以打开透视表数据，然后我需要将这些数据用于财务对帐。我必须经历同样的过程80次，但不是在循环中，因为我需要记录我发现的东西。然而，只有第一次有效，第二次在添加表切片器时获得。和我相信的名字有关。

如果需要，表格可以命名为单元格D6中的值，但是我不知道如何做到这一点，任何帮助都将不胜感激。

ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.ListObjects(ActiveSheet.ListObjects(1).name), "YEAR"). _
Slicers.Add ActiveSheet, , "YEAR", "YEAR", 186, 450.75, 144, 198.75

或者完整的代码。

Sub FORMAT()

    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 49407
    End With

    ActiveCell.Offset(0, 1).COPY
    ActiveCell.Select
    Selection.ShowDetail = True
    RANGE("AF2").Select
    Selection.PasteSpecial Paste:=xlPasteValues

    RANGE("D2").Select

    ActiveSheet.name = ActiveCell.Value

    ActiveSheet.Move After:=Worksheets(Worksheets.Count)

    Columns("B:c").Select
    Selection.Columns.Group

    Columns("H:J").Select
    Selection.Columns.Group

    Columns("L:N").Select
    Selection.Columns.Group

    Columns("T:V").Select
    Selection.Columns.Group

    Columns("K:K").Select
    Selection.NumberFormat = "#,##0.00"

    RANGE("A1").Select

    ActiveSheet.SORT.SortFields.Clear

    ActiveSheet.SORT.SortFields.Add2 Key:=RANGE("Q2:Q1000" _
        ), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal

    ActiveSheet.SORT.SortFields.Add2 Key:=RANGE("R2:r1000" _
        ), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal

    With ActiveSheet.SORT
        .SetRange RANGE("a1:V1000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1

    Rows("1:4").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

    Selection.End(xlDown).Select

    '''''''''''''

    ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.ListObjects(ActiveSheet.ListObjects(1).name), "YEAR"). _
        Slicers.Add ActiveSheet, , "YEAR", "YEAR", 186, 450.75, 144, 198.75

    ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.ListObjects(ActiveSheet.ListObjects(1).name), "QTR"). _
        Slicers.Add ActiveSheet, , "QTR", "QTR", 223.5, 488.25, 144, 198.75

    '''''''''''''

    ActiveSheet.Shapes.RANGE(Array("QTR")).Select
    ActiveSheet.Shapes.RANGE(Array("YEAR")).Select
    ActiveWorkbook.SlicerCaches("Slicer_YEAR").Slicers("YEAR").Left = 0
    ActiveWorkbook.SlicerCaches("Slicer_YEAR").Slicers("YEAR").Top = 0
    ActiveWorkbook.SlicerCaches("Slicer_YEAR").Slicers("YEAR").NumberOfColumns = 8
    ActiveWorkbook.SlicerCaches("Slicer_YEAR").Slicers("YEAR").ColumnWidth = 35.43
    ActiveSheet.Shapes("YEAR").Height = 56.69
    ActiveSheet.Shapes("YEAR").Width = 311.81

    ActiveSheet.Shapes.RANGE(Array("QTR")).Select
    ActiveWorkbook.SlicerCaches("Slicer_QTR").Slicers("QTR").Left = 316.06
        ActiveWorkbook.SlicerCaches("Slicer_QTR").Slicers("QTR").Top = 0
    ActiveWorkbook.SlicerCaches("Slicer_QTR").Slicers("QTR").NumberOfColumns = 4
    ActiveWorkbook.SlicerCaches("Slicer_QTR").Slicers("QTR").ColumnWidth = 35.43
    ActiveSheet.Shapes("QTR").Height = 56.69
    ActiveSheet.Shapes("QTR").Width = 161.57
    RANGE("a5").Select
    ```

Answer 1

我找到了一个简单的答案。字面上用"Activesheet.name“代替第一个"YEAR”

'ORIGINAL'
ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.ListObjects(1), "YEAR"). _
Slicers.Add ActiveSheet, , "YEAR", "YEAR", 186, 450.75, 144, 198.75

'FINAL'
ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.ListObjects(1), "YEAR"). _
Slicers.Add ActiveSheet, , ActiveSheet.Name , "YEAR", 186, 450.75, 144, 198.75

Answer 2

SlicerCaches.Add2返回一个SlicerCache对象，因此您可以捕获该对象并根据需要使用该引用。类似地，Slicers.Add为您提供了一个Slicer引用，您可以直接使用，而不需要知道它的名称：

Dim wb As Workbook, ws As Worksheet, scYear As SlicerCache, scQtr As SlicerCache
Dim slcYear As Slicer, slcQtr As Slicer

Set ws = ActiveSheet
Set wb = ws.Parent   'workbook with the activesheet

'...
'...

'create caches and slicers
Set scYear = wb.SlicerCaches.Add2(ws.ListObjects(1), "YEAR")
Set slcYear = scYear.Slicers.Add(ws, , "YEAR", "YEAR", 186, 450.75, 144, 198.75)

Set scQtr = wb.SlicerCaches.Add2(ws.ListObjects(1), "QTR")
Set slcQtr = scQtr.Slicers.Add(ws, , "QTR", "QTR", 223.5, 488.25, 144, 198.75)

'''''''''''''

With slcYear
    .Left = 0
    .Top = 0
    .NumberOfColumns = 8
    .ColumnWidth = 35.43
    .Height = 56.69
    .Width = 311.81
End With

With slcQtr
    .Left = 316.06
    .Top = 0
    .NumberOfColumns = 4
    .ColumnWidth = 35.43
    .Height = 56.69
    .Width = 161.57
End With