Question

我需要能够在VBA表单上的两个文本框（'txtDateFrom'和'txtDateTo'）中输入日期范围（我已经在Excel中创建了VBA表单）。然后，我需要根据列B和两个文本框中的日期条件从Sheet1中选择单个行（参见Sheet1的屏幕截图）。

我打算在我的VBA表单（cmdExtractData）上使用按钮的“click”事件来运行代码。然后我想把这些提取的数据放到我的电子表格的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 property，您可以将字符串看起来像日期与单元格中的实际日期进行比较。如果单元格中的日期（以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

VBA / excel文本框

2 个答案: