VBA / excel文本框中的date比较
我需要能够在两个文本框（“txtDateFrom”和“txtDateTo”）在VBA表单中inputdate范围（我已经在Excel中创build了VBA表单）。 然后，我需要根据B列和我的两个文本框中的date标准从Sheet1中select单个行（请参阅Sheet1的屏幕截图）。
我打算使用我的VBA表单（cmdExtractData）上的button的“单击”事件来运行代码。 然后，我想将提取的数据放到电子表格的Sheet2中，以便对其进行进一步的分析。 因此，Sheet2看起来与Sheet1完全一样，但只有那些与所选date条件匹配的数据行。
我很乐意做所有必要的错误检查（确保date有效等）。
电子表格数据：
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
这有效，但我不禁觉得这太简单了。 在执行代码时，我应该检查什么？ 我需要捆绑什么东西？
首先，VBA非常以美国为中心。 除非被视为基本的原始数值，否则您的DMYdate将会引起混淆。 通过使用Range.Text属性 ，您可以将string看起来像date与单元格中的实际date进行比较。 如果单元格中的date（B列开始于19/07/2015 ）确实是string，那么即使是string到string的比较也不会产生可靠的结果。 例如"15/04/2015" 不小于"11/03/2016" 。 将date视为date和string作为string。
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
以上处理date为date。 如果它们实际上是工作表中的string，则需要parsing例程来从string中提取正确的值。
好。 感谢所有帮助过我的人，这是非常宝贵的，如果没有你提供的提示和提示，我就不可能到达那里。 这是我结束的代码（工作正常）。 但是，如果有人看到任何明显的错误或有任何改善的build议，请让我知道。
' 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