Question

我正在尝试使用vba来运行一个切片器，我已经设法通过录制宏来完成。我现在尝试根据从B2到B13的单元格值多次运行切片器。每次切片器基于一个单元格值运行时，我想保存excel文件并循环，直到所有切片器选项都已运行。

这是代码;

Sub sliceandsend_rwanda()


'This defines the range of offices to run in the slicer
Dim ws1 As Worksheet
Dim sliceoff As Range
Set ws1 = ThisWorkbook.Sheets("Office Codes")
Set sliceoff = Range("B2:B13")



'This defines the file path and naming structure
Dim Name As String
Dim Month As String
Dim Folder As String

Name = "name"
Month = Format(CStr(Now), "(mmm yyyy) - ")
Folder = "location"

Workbooks("name.xlsx").Activate
Dim ws2 As Worksheet
Dim SliceName As Range
Set ws2 = ActiveWorkbook.Sheets("Select")
Set SliceName = Range("C30")

    'ActiveWorkbook.SlicerCaches("Slicer_Organisation_Hierarchy"). _
    'VisibleSlicerItemsList = Array( _
    '"[Organisations].[Organisation Hierarchy].[Dept - Office].&[1009]")

    'Workbooks("Africa Dept-Office Dashboard.xlsx").Activate
    'ActiveWorkbook.SaveAs Filename:=Folder & Name & Month & SliceName

Dim ws3 As Worksheet
Set ws3 = ThisWorkbook.Sheets("Office Codes")
Dim offRng As Range, cl As Range
Set offRng = Range("B2:B13")
Dim sTo As String

For Each cl In offRng

sTo = sTo & ";" & cl.Value
   Next cl


     ActiveWorkbook.SlicerCaches("Slicer_Organisation_Hierarchy"). _
    VisibleSlicerItemsList = _
    Array("[Organisations].[Organisation Hierarchy].[Dept - Office].&["&   cl.Value & "]")


    Workbooks("name.xlsx").Activate

Answer 1

我得到了它的工作;

Sub sliceandsend_rwanda()

'This defines the range of offices to run in the slicer
Dim ws1 As Worksheet
Dim sliceoff As Range
Set ws1 = ThisWorkbook.Sheets("name")
Set sliceoff = Range("B2:B13")

'This defines the file path and naming structure
Dim Name As String
Dim Month As String
Dim Folder As String

    Name = "name"
    Month = Format(CStr(Now), "(mmm yyyy) - ")
    Folder = "link"

Workbooks("name").Activate
Dim ws2 As Worksheet
Dim SliceName As Range
    Set ws2 = ActiveWorkbook.Sheets("name")
    Set SliceName = Range("C30")


Workbooks("name").Activate
    'ActiveWorkbook.SaveAs Filename:=Folder & Name & Month & SliceName

Dim ws3 As Worksheet
    Set ws3 = ThisWorkbook.Sheets("name")
Dim offRng As Range, cl As Range
    Set offRng = ThisWorkbook.Worksheets("name").Range("B2:B13")
Dim sTo As String

For Each cl In offRng
    sTo = sTo & cl.Value

    ActiveWorkbook.SlicerCaches("Slicer_Organisation_Hierarchy"). _
    VisibleSlicerItemsList = ("[Organisations].[Organisation Hierarchy].[Dept - Office].&[" & sTo & "]")

Next cl

End Sub

使用excel vba循环获取单元格值并在切片器

1 个答案: