Население плоского файла

Question

Я импортирую огромное количество данных из SharePoint в виде новой рабочей таблицы («Извлечение») в существующую книгу, в которой есть четыре других раздела. Я пытаюсь разработать макрос, который при запуске а.) Автоматически фильтрует данные по полю в Pull; b.) скопировать / «вставить значения» этих отфильтрованных данных в существующий лист, начиная с ячейки A5; c.) сбросьте фильтр на Pull для следующего листа.

Так, например, в Pull (имя листа по умолчанию «owssvr») у каждой строки есть дата в столбце AR, показывающая, когда был создан элемент в этой строке. Как автоматически фильтровать все элементы за предыдущий месяц в режиме извлечения (или, альтернативно, дать пользователю возможность выбрать месяц) и копировать / вставлять значения отфильтрованного результата в лист с названием «Ежемесячный отчет», начиная с ячейки A5 (с учетом того, что заголовок не меняется)? Это возможно?

Answer 1

Вы можете использовать AutoFilter и ShowAllData для фильтрации и фильтрации. Вот пример.

Sub CopyLastMonthFromThePull(shtCopyTo As Worksheet)
   Dim rngPullTable As Range, iColumnToFilter As Integer, strMonth As String

   ' this assumes that the pull data is the first Excel Table on ThePull worksheet named owssvr
   Set rngPullTable = ThisWorkbook.Worksheets("owssvr").ListObjects(1).Range
   rngPullTable.Parent.Activate

   ' determine the filter details
   strMonth = CStr(DateSerial(Year(Date), Month(Date) - 1, Day(Date))) ' one month prior to today
   iColumnToFilter = 44    ' Column AR is the 44th column

   ' filter the table
   rngPullTable.AutoFilter Field:=iColumnToFilter, Operator:=xlFilterValues _
                     , Criteria2:=Array(1, strMonth)
   DoEvents

   ' copy the filtered results. (This also copies the header row.)
   rngPullTable.Copy
   With shtCopyTo
      .Activate
      .Range("A5").PasteSpecial xlPasteFormulasAndNumberFormats
      .Columns.AutoFit
      .Range("A1").Select
   End With
   Application.CutCopyMode = False

   ' remove filter
   With rngPullTable.Parent
      .Activate
      .ShowAllData
   End With
   rngPullTable.Range("A1").Select

   ' End with the sheet being copied to active
   shtCopyTo.Activate

End Sub

Answer 2

Вот как бы я написал:

Option Explicit

Sub MonthFilter()
Dim LR As Long, MyDate As Date, d1 As Date, d2 As Date

MyDate = Application.InputBox("Enter any date in the month you wish to pull", "Enter Date", Date - 30, Type:=2)
If MyDate = 0 Then
    Exit Sub
Else
    d1 = DateSerial(Year(MyDate), Month(MyDate), 1)
    d2 = DateSerial(Year(MyDate), Month(MyDate) + 1, 1) - 1
End If

With Sheets("The Pull")
    .AutoFilterMode = False
    .Rows(1).AutoFilter
    .Rows(1).AutoFilter 44, Criteria1:=">=" & d1, _
           Operator:=xlAnd, Criteria2:="<=" & d2
    LR = .Cells(.Rows.Count, 44).End(xlUp).Row
    If LR > 1 Then .Range("A2:A" & LR).EntireRow.Copy Sheets("Monthly Report").Range("A5")
    .AutoFilterMode = False
End With

End Sub