Question

我有这个代码，我希望按两个日期过滤自动填充结果（例如：从01-01-2009到02-10-2010）。我怎样才能做到这一点？有人有线索吗？下面的代码简化了（当前的代码只有更多的范围）。我试图在If函数中添加condidions但我只得到错误...感谢您的帮助。顺便说一下，我对这段代码有很大的帮助，所以我是excel macro vba中的小菜鸟。）。

dimResult1，clean1等代表日期值。我不能做的是跳过nextcell如果oCellResult1.Offset（iCellCount，0）.Value = oCell.Offset（0,4）。值不在两个日期之间。

Private Sub Worksheet_Change(ByVal Target As Range)

Dim oCell As Excel.Range
Dim oCellResult1 As Excel.Range
Dim oCellResult2 As Excel.Range
Dim oCellClean1 As Excel.Range
Dim oCellClean2 As Excel.Range
Dim oRangeID As Excel.Range
Dim iCellCount As Integer


If Target.Address = "$T$4" Then

    'Set source data
    Set oRangeID = Sheets("Registo_EPI").Range("A3:A5000")

    'Define initial target for the results obtained
    'data
    Set oCellResult1 = Sheets("Distribuição_EPI").Range("U12") 
    'luvas
    Set oCellResult2 = Sheets("Distribuição_EPI").Range("E12") 

    'Clear up any previous data
    Set oCellClean1 = oCellResult1
    Set oCellClean2 = oCellResult2
    While Len(oCellClean1.Value) > 0

        oCellClean1.ClearContents
        Set oCellClean1 = oCellClean1.Offset(1, 0)

        oCellClean2.ClearContents
        Set oCellClean2 = oCellClean2.Offset(1, 0)

    Wend

    'Scans source range for match data
    For Each oCell In oRangeID

        If oCell.Value = "" Then Exit For

        If oCell.Value = Target.Value Then

           'data
           oCellResult1.Offset(iCellCount, 0).Value = oCell.Offset(0, 4).Value 
           'luvas
           oCellResult2.Offset(iCellCount, 0).Value = oCell.Offset(0, 9).Value 
           iCellCount = iCellCount + 1

           If iCellCount = 14 Then iCellCount = iCellCount + 20


        End If

    Next oCell

End If

End Sub

Answer 1

如果我理解你想要达到的目标，我们可以在IF声明中添加新条件。

这将是：

    'Ensure the value in oCell is a date; otherwise the comparison won't work
    If oCell.Value = Target.Value and IsDate(oCell.Value) Then

        'Date Comparison
        if cDate(oCell.Value) > cdate("01-01-2009") and _
            cDate(oCell.Value) < ("02-10-2010") then

            'data
            oCellResult1.Offset(iCellCount, 0).Value = oCell.Offset(0, 4).Value 
            'luvas
            oCellResult2.Offset(iCellCount, 0).Value = oCell.Offset(0, 9).Value 
            iCellCount = iCellCount + 1

            If iCellCount = 14 Then iCellCount = iCellCount + 20

        end if

    End If

按日期或两个日期之间过滤结果

1 个答案: