Question

我要做的是从工作网站下载报告/查询，因为它不允许我保存报告/查询，因此必须手动执行。我保存文件，然后先打开

然后它打开我的excel模板，将宏表中的数据复制到该模板中，因为它隐藏并过滤了很多东西。

然后，我将下载的报告复制并粘贴到宏查询数据表中。数据后面的列中有一些vlookup。

然后，它首先按每个代理商过滤数据透视表-这适用于所有代理商。如图所示，我还有另外3个人在做。 2是通过代理商，然后是单位ID，另一个是通过供应商名称。我试图在一个数据透视表上执行此操作，但结果一团糟。（如果您可以向我展示如何编写代码，则要加分）。

这就是问题所在-进行过滤时，它将什么也不会拾取，并保存一个空文件超过20次，直到拾取其他东西，然后开始将每个代理商分开放在一个文件夹中。避免出现空白的过滤器）。但是它仍然不止一次地尝试着相同的事情。我该怎么做才能只选择数据透视表中的内容？

我需要添加我的电子邮件代码以自动通过电子邮件发送每张纸，但是它可以保存20多个空电子邮件。我必须删除电子邮件，直到找到正确的电子邮件。第二个问题是，当我为每个单元ID进行过滤时，它会保存一个包含所有单元ID的文件，然后在最后一个单元上运行。它不断循环遍历最后20次。除非我停止它，否则它不会停止。我不知道最后一个项目是什么，所以我停止了它，希望不再需要再次运行它来获取更多数据。

然后将其分别保存。（额外的好处是，您告诉我它将如何创建具有今天日期的文件夹并将每个文件夹保存在该文件夹中。我尝试过并将其保存到备份驱动器中。它需要保存在共享驱动器中。

很抱歉，这很多-我想做得透彻一些，以免遗漏或误解。这些报告过去通常要花我2-3个小时。我已将其缩减为在10分钟内运行这些报告-如果我能使它停止重复收集相同的数据，那么电子邮件部分会很棒。

   Sub PivotTable2()
    Dim src As Workbook
    Set src = Workbooks.Open("V:\existingsavedfilefromquery", True, True)
    ThisWorkbook.Activate
    Workbooks.Add Template:= _
    "V:\opensatemplatethatgetscopiedto\EINV_NEED_OK_TO_PAY_V7 - TEMPLATE.xltx"
    Windows("EINV_NEED_OK_TO_PAY_V7.xlsx").Activate 'selects all data in the macro book as there is vloopkups in the column after,
        Range("A3:AG3").Select
         Range(Selection, Selection.End(xlDown)).Select
        Range(Selection, Selection.End(xlToRight)).Select
        Selection.Copy
        Windows("EINV_NEED_OK_TO_PAY_V7 - Testing Macro1").Activate
        Sheets("Query_Data").Select
        Range("A2").Select
        ActiveSheet.Paste
        Sheets("Pivot Table").Select
        Range("A1").Select
        Application.CutCopyMode = False
        ActiveWorkbook.RefreshAll


    Dim pt As PivotTable, pi As PivotItem, pf As PivotField
    Dim lLoop As Long


    Set pt = Sheets("Pivot Table").PivotTables(1)
    Set pf = pt.PageFields(1) 
    With ActiveSheet.PivotTables(1).PivotFields("Supplier2")
    .PivotItems("(blank)").Visible = False
     End With    

    For Each pi In pf.PivotItems
    On Error Resume Next
        pt = Sheets("Pivot Table").Select
        pf.CurrentPage = pi.Value
    On Error GoTo 0

        Range("A6").Select
        Selection.ShowDetail = True
        Range("A2").CurrentRegion.Select *'this data changes all the time could be one line to 100 or so. it allows to only pick up the one line or it takes 1500000 line and save file take 30 minutes to save.*
        Selection.Copy
        Windows("EINV_NEED_OK_TO_PAY_V7 - TEMPLATE1").Activate
        Range("A2").Select
        Range("A2").Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        ActiveSheet.AutoFilter.ApplyFilter
        Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).EntireRow.Delete

    Dim Path As String
    Dim FileName1 As String


        Path = "V:\pathto shared drive\"
        FileName1 = Range("A2")
        ActiveWorkbook.SaveAs FileName:=Path & FileName1 & " " & "EINV_NEED_OK_TO_PAY_V7 - " & Format(Date, "MM-DD-YYYY") & ".xlsx" _
            , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False


      ActiveWindow.Close
        Workbooks.Add Template:= _
            "V:\opensatemplatethatgetscopiedto\EINV_NEED_OK_TO_PAY_V7 - TEMPLATE.xltx"

    Windows("EINV_NEED_OK_TO_PAY_V7 - Testing Macro1").Activate
    Sheets("Pivot Table").Select

     ILoop = ILoop + 1

      Next pi

    Windows("EINV_NEED_OK_TO_PAY_V7.xlsx").Close
    Windows("EINV_NEED_OK_TO_PAY_V7 - TEMPLATE1").Close

    End Sub

在数据透视表中循环遍历VBA代码

0 个答案: