需要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