VBA / Excel文本框中的日期比較

Question

我需要能夠在VBA表單（我已經在Excel中創建了VBA表單）的兩個文本框中（“ txtDateFrom”和“ txtDateTo”）輸入日期范圍。 然后，我需要根據B列和兩個文本框中的日期條件從Sheet1（請參閱Sheet1的屏幕截圖）中選擇單個行。

我打算在VBA表單（cmdExtractData）上使用按鈕的“單擊”事件來運行代碼。 然后，我想將提取的數據放入電子表格的Sheet2中，以便對其進行進一步分析。 因此，Sheet2的外觀將與Sheet1完全相同，但是只有那些與所選日期條件匹配的數據行。

我很樂意進行所有必要的錯誤檢查（確保日期有效等）。

試算表資料：

1,19/07/2015,1,F,P,White Goods,One Off,£250.00
2,24/08/2015,2,D,A,Handyman Services,Ongoing,£500.00
3,21/07/2015,3,W,L,Home Assistance,One Off,£750.00
4,01/09/2015,4,F,C,Convalescent/Respite,One Off,£250.00
5,17/06/2015,5,D,H,Living Expenses,Ongoing,£500.00
6,29/11/2015,1,F,O,Specialist Equipment,One Off,£250.00
7,12/12/2015,4,D,O,Convalescent/Respite,One Off,£250.00
8,23/01/2016,2,D,L,Transport Costs,One Off,£500.00
9,27/02/2016,4,W,L,Living Expenses,One Off,£500.00
10,03/11/2015,4,F,C,Convalescent/Respite,One Off,£750.00

---

好吧，經過反復擺弄之后，我有了一些行之有效的基礎...

' Clear Sheet2 ready for new data
Sheet2.Cells.ClearContents

' First find the last row in the spreadsheet that has data in it.
LastRowFrom = Range("B" & Rows.Count).End(xlUp).Row

'Loop for each entry in column B
For i = 2 To LastRowFrom
  'get the next date from column B
   TempDate = Range("B" & i).Value

   If TempDate >= txtDateFrom.Text And TempDate <= txtDateTo.Text Then
   ' Write code here if the date is in the selected range
    Range("A" & i).EntireRow.Copy
    Sheet2.Range("A" & i).End(xlUp).Offset(1).PasteSpecial
    Sheet1.Select
  End If
Next i

這可行，但我不禁覺得這太簡單了。 我是否應該在執行此代碼的同時檢查任何內容。 我需要綁扎一些松散的末端嗎？

Answer 1

首先，VBA是非常以EN-US為中心的。 您的DMY日期將引起混亂，除非將其視為其基礎原始數值。 通過使用Range.Text屬性 ，您可以將看起來像日期的字符串與單元格中的實際日期進行比較。 如果單元格中的日期（從19/07/2015開始的B列）確實是字符串，那么即使是字符串之間的比較也不會產生可靠的結果； 例如"15/04/2015" 不小於"11/03/2016" 。 將日期視為日期，將字符串視為字符串。

Dim dtDateFrom As Date, dtDateTo As Date, tempDate As Date
Dim i As Long, lastRowFrom As Long

' Clear Sheet2 ready for new data
Sheet2.Cells.ClearContents

' provide a parent worksheet
With Sheet1
    dtDateFrom = .Range("z1").Value
    dtDateTo = .Range("z2").Value
   'need to get real dates from your text boxes possibly like this
    'dtDateFrom = DateSerial(Split(txtDateFrom, Chr(47))(2), _
                             Split(txtDateFrom, Chr(47))(1), _
                             Split(txtDateFrom, Chr(47))(0))
    'dtDateTo = DateSerial(Split(txtDateTo, Chr(47))(2), _
                           Split(txtDateTo, Chr(47))(1), _
                           Split(txtDateTo, Chr(47))(0))

    ' First find the last row in the spreadsheet that has data in it.
    lastRowFrom = .Range("B" & Rows.Count).End(xlUp).Row

    'Loop for each entry in column B
    For i = 2 To lastRowFrom
        'get the next date from column B
        tempDate = Range("B" & i).Value

        If tempDate >= dtDateFrom And tempDate <= dtDateTo Then
            ' simple copy with destination
            .Range("A" & i).EntireRow.Copy _
                Destination:=Sheet2.Range("A" & i).End(xlUp).Offset(1)
        End If
    Next i
End With

以上將日期視為日期。 如果它們實際上是工作表上的字符串，則需要一個解析例程來從字符串中提取正確的值。

Answer 2

好。 謝謝所有幫助我的人，這是無價的，沒有您提供的提示，我無法到達那里。 這是我最終得到的代碼（工作正常）。 但是，如果任何人看到任何明顯的錯誤或有任何改進建議，請告訴我。

' Clear Sheet2 ready for new data

Sheet2.Cells.ClearContents

' provide a parent worksheet

With Sheet1
dtDateFrom = .Range("z1").Value
dtDateTo = .Range("z2").Value

  'Get real dates from text boxes
dtDateFrom = DateSerial(Split(txtDateFrom, VBA.Chr(47))(2), _
Split(txtDateFrom, VBA.Chr(47))(1), _
Split(txtDateFrom, VBA.Chr(47))(0))
dtDateTo = DateSerial(Split(txtDateTo, VBA.Chr(47))(2), _
Split(txtDateTo, VBA.Chr(47))(1), _
Split(txtDateTo, VBA.Chr(47))(0))

' First find the last row in the spreadsheet that has data in it.
lastRowFrom = .Range("B" & Rows.Count).End(xlUp).Row

'Loop for each entry in column B
For i = 2 To lastRowFrom
    'get the next date from column B
    tempDate = Range("B" & i).Value

        ' This code searches Sheet1 for matching Dates and Selected Area
    If tempDate >= dtDateFrom And tempDate <= dtDateTo And SelectedArea = 0 Then
            Sheet1.Range("A" & i).EntireRow.Copy _
            Destination:=Sheet2.Range("A" & i).End(xlUp).Offset(1)
        ElseIf tempDate >= dtDateFrom And tempDate <= dtDateTo And SelectedArea = 1 Then
            Sheet1.Range("A" & i).EntireRow.Copy _
            Destination:=Sheet2.Range("A" & i).End(xlUp).Offset(1)
                Sheet2.Range("A1:H1").AutoFilter Field:=3, Criteria1:="1"
        ElseIf tempDate >= dtDateFrom And tempDate <= dtDateTo And SelectedArea = 2 Then
            Sheet1.Range("A" & i).EntireRow.Copy _
            Destination:=Sheet2.Range("A" & i).End(xlUp).Offset(1)
                Sheet2.Range("A1:H1").AutoFilter Field:=3, Criteria1:="2"
        ElseIf tempDate >= dtDateFrom And tempDate <= dtDateTo And SelectedArea = 3 Then
            Sheet1.Range("A" & i).EntireRow.Copy _
            Destination:=Sheet2.Range("A" & i).End(xlUp).Offset(1)
                Sheet2.Range("A1:H1").AutoFilter Field:=3, Criteria1:="3"
        ElseIf tempDate >= dtDateFrom And tempDate <= dtDateTo And SelectedArea = 4 Then
            Sheet1.Range("A" & i).EntireRow.Copy _
            Destination:=Sheet2.Range("A" & i).End(xlUp).Offset(1)
                Sheet2.Range("A1:H1").AutoFilter Field:=3, Criteria1:="4"
        ElseIf tempDate >= dtDateFrom And tempDate <= dtDateTo And SelectedArea = 5 Then
            Sheet1.Range("A" & i).EntireRow.Copy _
            Destination:=Sheet2.Range("A" & i).End(xlUp).Offset(1)
                Sheet2.Range("A1:H1").AutoFilter Field:=3, Criteria1:="5"
    End If
Next i
End With