Question

我从SharePoint导入大量数据作为新工作表（“The Pull”）在包含其他四个部分的现有书籍上。我正在尝试开发一个宏，当运行时，a。）会自动过滤数据中的一个字段; b。）将过滤后的数据复制/“粘贴”到从单元格A5开始的现有工作表中; c。）重置Pull上的过滤器以获得下一张纸。

例如，在Pull（默认工作表名称“owssvr”）中，每行在列AR中都有一个日期，显示该行中的项目何时创建。如何在拉动中自动过滤上个月的所有项目（或者，为用户提供选择月份的选项），并将过滤结果的值复制/粘贴到名为“每月报告”的工作表中A5（允许标题不变）？这可能吗？

Answer 1

我就是这样写的：

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

Answer 2

您可以使用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

平面文件的人口

2 个答案: