Question

我正在尝试执行以下一系列操作：

打开一个输入框，输入开始日期，并将该日期放在指定工作表的指定单元格中。
打开一个输入结束日期的输入框，并将该日期放在指定工作表的指定单元格中。
从位于这些日期之间和/或这些日期的大型数据集中选择数据行。
将该数据复制到另一个工作表（sheet2）。

示例数据：

Sol Id  Acct No Name    DATE
20  12  JOHN STEVE  16/09/2009
20  13  ROBERT V    31/07/2011
4   14  JOHNNY WALKER   30/04/2012
20  15  LA PRUDENCEE    30/04/2013
20  16  ddd 30/06/2013
11  17  DD  16/09/2013
20  18  EED 30/09/2013
5   19  EED 01/10/2013
20  20  DD  30/11/2013
2   21  RRR 19/12/2013
7   22  RDS 01/01/2014
20  23  DSS 24/01/2014
5   24  223 31/01/2014
5   25  44  31/01/2014
20  26  555 31/01/2014
20  27  666 24/02/2014

日期一直持续到2016年12月31日。我想选择开始日期16/09/2009，结束日期为2015年12月31日，并粘贴到sheet2。

我的VBA代码是：

Option Explicit

Sub Data_Date_Filter()

Dim sDate As Variant, eDate As Variant

sDate = Application.InputBox("Enter the starting date as mm/dd/yyyy", Type:=1 + 2)
eDate = Application.InputBox("Enter the Ending date as mm/dd/yyyy", Type:=1 + 2)

Application.ScreenUpdating = False

Sheet2.Cells.ClearContents

With Sheet1
    .AutoFilterMode = False
    .Range("D1").CurrentRegion.AutoFilter field:=2, Criteria1:=">=" & sDate, Operator:=xlAnd, Criteria2:="<=" & eDate
    .Range("D1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy Sheet2.Range("A1")
End With

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

它不会复制到第2页。

Answer 1

以下代码将执行我认为您正在尝试执行的操作。基本上你错过了将值实际粘贴到Sheet1的Sheet2中的代码。

我做了以下事情：

对日期变量添加了错误检查，因为从输入框中单击“取消”返回了一个False值;这导致自动过滤器出错。
创建了wkb和wks个变量，以便更轻松地使用工作簿和工作表方法。
将wkb.Worksheets("Sheet2").Range("A1").PasteSpecial添加到处理程序，将复制的值粘贴到工作表2中。

重新格式化方法的特性遵循VBA标准，而不是skrewy Excel（“：=”）语法。

Option Explicit

Sub Data_Date_Filter()
  On Error GoTo ErrHandler

  Dim wkb         As Excel.Workbook
  Dim wks         As Excel.Worksheet
  Dim sDate       As Variant
  Dim eDate       As Variant

  Set wkb = Application.ThisWorkbook

  sDate = Application.InputBox("Enter the starting date as mm/dd/yyyy", , , , , , , vbOKCancel)

  eDate = Application.InputBox("Enter the Ending date as mm/dd/yyyy", , , , , , , vbOKCancel)

  'CHECK IF DATES ARE NULL DUE TO CANCEL BUTTON CLICK
  If sDate = False Or eDate = False Then Exit Sub

  'TURN OFF SCREEN UPDATING AND COPY/PASTE VALUES FROM SHEET1 TO SHEET2
  Application.ScreenUpdating = False

  wkb.Worksheets("Sheet2").Cells.ClearContents

  Set wks = wkb.Worksheets("Sheet1"): wks.Activate

  With wks
     .Range("A1:D1").AutoFilter
     .Range("D1").AutoFilter 4, ">=" & sDate, xlAnd, "<=" & eDate
     .Range("D1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy
  End With

  wkb.Worksheets("Sheet2").Range("A1").PasteSpecial

  With Application
      .CutCopyMode = False
      .ScreenUpdating = False
  End With

  Set wks = Nothing: Set wkb = Nothing

  ExitHandler:
     Exit Sub

  ErrHandler:
     Stop: Debug.Print Err.Description: Err.Clear: Resume
End Sub

希望这有帮助！

使用带输入框的日期范围并选择要复制和粘贴的数据

1 个答案: