Question

我在这里有一个场景，我在其中有一个名为的三个标签每张纸的Sheet1，Sheet2，Sheet3和Column H包含日期。

我想要用户定义的VBA程序使用输入框和开始日期和结束日期程序必须在H列中循环才能找到单元格上的日期介于指定的日期范围之间由用户在输入框中。如果程序能够找到一个介于该指定范围之间的日期用户然后复制该行并粘贴一个名为“FINAL”的新选项卡以同样的方式，它必须转到表2并执行相同的操作并复制行并粘贴在“FINAL”标签中。

因此，如果您看到H列中的onc需要两个循环然后在表格中

我写了一些类似的东西，但很难得到这个完成后，对这方面的任何帮助都将不胜感激。

Sub CopyData()
    Application.ScreenUpdating = False
    Dim inputboxa As Date
    Dim inputboxb As Date
    Dim ws As Worksheet
    Dim cell As Range

    inputboxa = startdate
    inputboxb = enddate

    startdate = InputBox("Enter Start Date" & vbCrLf & vbCrLf & "dd/mm/yyyy Format", "Lease", "01/02/2014", 500, 700)
    enddate = InputBox("Enter enddate Date" & vbCrLf & vbCrLf & "dd/mm/yyyy Format", "Lease", "28/02/2014", 500, 700)

    For Each ws In Worksheets

        If ws.Visible = True And ws.Name <> "303010 V094" Then
            Sheets(ws.Name).Select

            For Each cell In Range("H1:H1000").Cells
                ''Range("h1:h1000").Select
                ''Do Until Range("h1:h1000").Value = vbNullString
                If Range(cell).Value >= startdate And Range("h1").Value <= enddate Then
                    Range(cell).EntireRow.Copy Sheets("test").Cells(Rows.Count, "A").End(xlUp).Offset(2, 0)
                End If
            Next cell

            Application.ScreenUpdating = True
            ''End If
        End If
    Next ws
End Sub

Answer 1

您需要使用 datediff 来比较日期值：

Sub CopyData()
Application.ScreenUpdating = False
Dim inputboxa As Date
Dim inputboxb As Date
Dim ws As Worksheet
Dim cell As Range


inputboxa = startdate
inputboxb = enddate


startdate = InputBox("Enter Start Date" & vbCrLf & vbCrLf & "dd/mm/yyyy Format", "Lease", "01/02/2014", 500, 700)
enddate = InputBox("Enter enddate Date" & vbCrLf & vbCrLf & "dd/mm/yyyy Format", "Lease", "28/02/2014", 500, 700)


For Each ws In Worksheets


If ws.Visible = True And ws.Name <> "303010 V094" Then
Sheets(ws.Name).Select

For Each cell In Range("H1:H1000").Cells

''Range("h1:h1000").Select
''Do Until Range("h1:h1000").Value = vbNullString

If DateDiff("d", cell.Value, startdate) <= 0 And DateDiff("d", cell.Value, enddate) > 0 Then
cell.EntireRow.Copy Sheets("test").Cells(Rows.Count, 1).End(xlUp).Offset(2, 0)
End If
Next cell


Application.ScreenUpdating = True
''End If
End If
Next ws
End Sub

用户单元格而不是范围（单元格）。还要确保你的日期格式实际上是“dd / mm / yyyy”，或者通过读取不正确的值来比较失败，并且那些表（“test”）的列A不为空（或者你将重写为同一个单元格一遍又一遍）

Answer 2

您的代码存在许多问题。

Range(cell)是多余的;只需使用cell
你没有声明startdate / enddate。而你正在声明inputboxa / inputboxb但没有使用它们。
您正在将startdate / enddate作为字符串进行读取，然后将其与列H中的值进行比较，这些值与日期格式最相似。您需要在比较之前将startdate / enddate转换为Date值。
.Cells中的Range("H1:H1000").Cells不是必需的。
不确定为什么要关闭ScreenUpdating，然后在处理完每张纸后重新打开它。你可能想在最后做一次。

尝试以下代码。请注意，这假设您的本地日期格式为dd / mm / yyyy。

Option Explicit
Sub CopyData()
    Application.ScreenUpdating = False
    Dim startDate As Date
    Dim endDate As Date
    Dim ws As Worksheet
    Dim cell As Range

    startDate = DateValue(InputBox("Enter Start Date" & vbCrLf & vbCrLf & "dd/mm/yyyy Format", "Lease", "01/02/2014", 500, 700))
    endDate = DateValue(InputBox("Enter enddate Date" & vbCrLf & vbCrLf & "dd/mm/yyyy Format", "Lease", "28/02/2014", 500, 700))

    For Each ws In Worksheets
        If ws.Visible = True And ws.Name <> "303010 V094" And ws.Name <> "test" Then
            Sheets(ws.Name).Select

            For Each cell In Range("H1:H1000")
                If cell.Value >= startDate And cell.Value <= endDate Then
                    cell.EntireRow.Copy Sheets("test").Cells(Rows.Count, "A").End(xlUp).Offset(2, 0)
                End If
            Next cell

        End If
    Next ws
    Application.ScreenUpdating = True
End Sub

需要Excel Visual Basic帮助

2 个答案: