Фильтровать результаты по дате или по двум датам - PullRequest
0 голосов
/ 07 апреля 2011

У меня есть этот код, и я хочу отфильтровать результаты автозаполнения по двум датам (например, с 01-01-2009 по 02-10-2010).Как я могу это сделать?У кого-нибудь есть подсказка?Код ниже упрощен (текущий имеет только больше диапазонов).Я пытался добавить условия в функцию If, но получаю только ошибку ... спасибо за вашу помощь.Кстати, мне очень помог этот код, поэтому я немного новичок в макросе Excel vba:).

dimResult1, clean1 и т. Д. Соответствуют значениям даты.Что я не могу сделать, так это перейти к следующей ячейке, если 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

1 Ответ

0 голосов
/ 08 апреля 2011

Если я правильно понял, чего вы пытаетесь достичь, мы можем добавить новое условие в нашу инструкцию 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
...