宏查找用户输入日期范围并删除范围外的所有内容

Question

想知道是否有人可以帮助我开发一个简单的用户界面宏。

我有一组数据，第一列（A）是日期。日期范围可以是任意范围，因此可以从任何开始日期到结束日期（大多数时间是6/8周）。让我们说，为了论证，日期范围从2014年12月31日18:00到2015年2月9日18:00（注意日期是dd / mm / yyyy的英国格式）。我想要询问用户他们去的开始和结束日期范围 - 比如2015年1月1日到2015年1月31日。一旦他们选择了范围，宏应该删除所有日期范围之前的所有内容（并向上移动单元格）并删除所选日期范围之后的所有内容。日期范围以10分钟为增量。

我已经编写了一些代码来开始：

Public Sub DateRngInput()

Dim startDate As String
Dim endDate As String
Dim sRow As Long
Dim eRow As Long
Dim lastRow As Long

lastRow = Cells(Rows.Count, 1).End(xlUp).Row
startDate = Left(Worksheets("Template").Cells(1, 1), 10)
endDate = Left(Worksheets("Template").Cells(lastRow, 1), 10)

sDate = InputBox("Choose Start date (dd/mm/yyyy)" & vbNewLine & vbNewLine & "Data range starts at " & startDate)
eDate = InputBox("Choose End date (dd/mm/yyyy)" & vbNewLine & vbNewLine & "Data range ends at " & endDate)

'On Error Resume Next
sRow = Worksheets("Template").Range("$A$1:$A" & lastRow).Find(sDate, LookAt:=xlPart).Row
eRow = Worksheets("Template").Range("$A$1:$A" & lastRow).Find(eDate, SearchDirection:=xlPrevious, LookAt:=xlPart).Row

MsgBox ("Your date range is from: " & vbNewLine & sDate & " at Row " & sRow & vbNewLine & "To " & vbNewLine & eDate & " at Row " & eRow)

End Sub

宏错误出现在以下行，运行时错误“91”：

sRow = Worksheets("Template").Range("$A$1:$A" & lastRow).Find(sDate, LookAt:=xlPart).Row

非常感谢任何帮助！

感谢。

Answer 1

假设我们有以下数据：

请注意，材料甚至没有排序！我们希望仅保留2015年2月1日至2015年2月15日期间的数据。

我们将从底部向上移动。我们删除了日期限制之外的所有行

Sub DateKleaner()
    Dim early As Date, late As Date, N As Long
    Dim dt As Date

    early = DateSerial(2015, 2, 1)
    late = DateSerial(2015, 2, 15)
    N = Cells(Rows.Count, "A").End(xlUp).Row

    For i = N To 1 Step -1
        dt = Cells(i, 1).Value
        If dt > late Or dt < early Then
            Cells(i, 1).EntireRow.Delete
        End If
    Next i
End Sub

我们将留下：

修改＃1：

以下是一些要求用户提供日期的代码：

Sub DateKleaner()
    Dim early As Date, late As Date, N As Long
    Dim dt As Date

    early = CDate(Application.InputBox(Prompt:="Please enter start date:", Type:=2))
    late = CDate(Application.InputBox(Prompt:="Please enter end date:", Type:=2))
    MsgBox early & vbCrLf & late

    N = Cells(Rows.Count, "A").End(xlUp).Row

    For i = N To 1 Step -1
        dt = Cells(i, 1).Value
        If dt > late Or dt < early Then
            Cells(i, 1).EntireRow.Delete
        End If
    Next i
End Sub

当然，您可能会使用自己的 UserForm 来完成同样的事情。