需要Excel Visual Basic帮助

Question

我有一个场景，在这里我有一个叫做 的三个选项卡，每个工作表Sheet1，Sheet2，Sheet3和H列包含日期。

我想VBA程序什么其中用户定义 的开始日期和结束日期使用输入框和 程序具有循环在H列以便发现 日期细胞上的时间范围指定 之间落在由用户在输入框中输入。如果程序能够 找到 用户指定的范围之间的日期，则复制该行并粘贴到名为“FINAL”的新选项卡中，其方式与第2页相同，并执行相同的操作动作 并复制该行并粘贴到“FINAL”选项卡中。

所以，如果你看到两个循环的ONC需要在列H和 然后在表

我已经写了一些像这样的事情，但有一个很难得到这个 完成，在这方面的任何帮助将非常感谢。

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

您的代码有许多问题。

1. Range(cell)是多余的;只是使用cell
2. 你没有声明startdate/enddate。你声明inputboxa/inputboxb但不使用它们。
3. 您正在读取startdate/enddate作为字符串，但将它与列H中最接近日期格式的值进行比较。在比较之前，您需要将startdate/enddate转换为日期值。
4. .Cells in Range("H1:H1000").Cells没有必要。
5. 不确定为什么你要关闭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