使用带输入框的日期范围并选择要复制和粘贴的数据-Java 学习之路

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

打开一个输入框，输入开始日期，并将该日期放在指定工作表的指定单元格中 .
打开一个输入结束日期的输入框，并将该日期放在指定工作表的指定单元格中 .
从位于这些日期之间和/或这些日期的大型数据集中选择数据行 .
将该数据复制到另一个工作表（ 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，结束日期31/12/2015，并粘贴 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 .

1 回答

下面的代码将完成我认为您正在尝试做的事情 . 基本上你错过了将值实际粘贴到Sheet1的Sheet2中的代码 .

我做了以下事情：

添加了对日期变量的错误检查，因为从输入框中单击"Cancel"返回了一个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

希望这可以帮助！

回复于 2024-05-08T00:44:27+08:00

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

1 回答

相关问题