Как мне распечатать и сохранить мой последний массив? - PullRequest
0 голосов
/ 28 января 2019

У меня есть скрипт, который отображает данные и печатает массив в шаблон на основе того, когда значения в столбце изменяются (когда начинается следующий набор дубликатов), в основном останавливается и печатает и массив, когда ячейки типа M2<>M3 имеют дело.

Он проходит и сохраняет копию из шаблона для всех, кроме окончательного набора данных, он просто помещается в шаблон и не сохраняется.Как я могу отредактировать свой код, чтобы он прошел через все значения и не оставил последний набор данных для ручного сохранения?

Option Explicit

Sub Main()

  Dim wb As Workbook
  Dim Report_Data, Last, Login
  Dim i As Long, j As Long, k As Long, a As Long
  Dim Destination_Rng As Range


  Workbooks.Open filename:="C:\Goal_Report_Template.xlsx"

  Set wb = Workbooks("Goal_Report_Template.xlsx")

  Set Destination_Rng = wb.Sheets("Sheet1").Range("A2")

  With ThisWorkbook.Sheets("Q1 report")
    Report_Data = .Range("W2", .Range("A" & Rows.Count).End(xlUp))
  End With

  wb.Activate

  Application.ScreenUpdating = False


  For i = 1 To UBound(Report_Data)

    If Report_Data(i, 14) <> Last Then

      If i > 1 Then

        Destination_Rng.Select

        wb.SaveCopyAs ThisWorkbook.Path & Application.PathSeparator & _
          ValidFileName(Login & " - " & Last & " - Goal Reporting.xlsx")
      End If

      Rows(1).Offset(1, 0).Resize(Rows.Count - 1).EntireRow.ClearContents

      Last = Report_Data(i, 14)
      Login = Report_Data(i, 13)

      j = 0
    End If

    a = 0
    For k = 1 To UBound(Report_Data, 2)
      Destination_Rng.Offset(j, a) = Report_Data(i, k)
      a = a + 1
    Next

    j = j + 1

  Next

End Sub

1 Ответ

0 голосов
/ 29 января 2019

Вам необходимо выполнить еще один SaveAs после выхода из цикла i.Вы можете избежать дублирования кода, разбив его на отдельную подпрограмму.

Не проверено:

Sub Main()

    Dim wb As Workbook
    Dim Report_Data, Last, Login, Current
    Dim i As Long, j As Long, k As Long, a As Long
    Dim Destination_Rng As Range

    Set wb = Workbooks.Open(Filename:="C:\Goal_Report_Template.xlsx")
    Set Destination_Rng = wb.Sheets("Sheet1").Range("A2")

    With ThisWorkbook.Sheets("Q1 report")
        Report_Data = .Range("W2", .Range("A" & .Rows.Count).End(xlUp))
    End With

    Application.ScreenUpdating = False

    For i = 1 To UBound(Report_Data)

        Current = Report_Data(i, 14)

        If Current <> Last Then
            If i > 1 Then SaveCopy wb, Login, Last '<< save this one
            Destination_Rng.CurrentRegion.Offset(1, 0).ClearContents
            Login = Report_Data(i, 13)
            j = 0
        Else
            j = j + 1
        End If

        For k = 1 To UBound(Report_Data, 2)
            Destination_Rng.Offset(j, k - 1) = Report_Data(i, k)
        Next k

    Next i

    SaveCopy wb, Login, Last '<< save the last report

End Sub

Sub SaveCopy(wb As Workbook, Login, Last)
    wb.SaveCopyAs ThisWorkbook.Path & Application.PathSeparator & _
                  ValidFileName(Login & " - " & Last & " - Goal Reporting.xlsx")
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...