使用VBA在2日期之间使用标准的搜索引擎

时间:2016-03-15 04:23:37

标签: excel vba excel-vba search-engine

我尝试使用vba excel进行搜索,并找到类似这样的代码

Sub Search1()
    Dim sCol As String
    Dim rgFind As Range, rgData As Range, rgCell As Range
    Dim iCol As Integer
    Dim lRow As Long
    Dim vCrit As Variant

    Range(Range("m8"), Range("m8").End(xlToRight).End(xlDown)).ClearContents
    sCol = Range("n3").Value
    Set rgFind = Range("a2:j2").Find(sCol, lookat:=xlWhole, MatchCase:=True)
    iCol = rgFind.Column
    lRow = Range("a2").CurrentRegion.Rows.Count
    vCrit = Range("n5").Value
    Set rgData = Range(Cells(3, iCol), Cells(lRow, iCol))
    For Each rgCell In rgData
        Set rgFind = rgCell.Find(vCrit, lookat:=xlPart, MatchCase:=False)
        If Not rgFind Is Nothing Then
            Range(Cells(rgCell.Row, 1), Cells(rgCell.Row, 10)).Copy
            Cells(Rows.Count, 13).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
            Application.CutCopyMode = False
        End If
    Next rgCell
    Range("n5").Select 
End Sub

但是这个脚本只搜索包含我搜索字段的字母和数字的数据。

但我想在2个日期之间搜索数据。我选择要搜索的字段(包含日期数据的字段)并在2日期之间搜索数据。

这里是文件 https://mega.nz/#!y5ZHFKIY!OpHpyKuorC0iHVlOGZW0g-qXfNAv9GxL0wyBpN45sLE

我已经尝试使用

更改脚本
rSearch = Sheet1.Range("B3", Sheet1.Range("B" & Rows.Count).End(xlUp))
'search data in range B3 - B (contain data date) and then using change the if 
if rSearch >= Date1 Or rSearch <= Date2

但错误类型不匹配或其他什么 有人可以帮助我,所以我可以在2日期之间搜索数据

之前谢谢

2 个答案:

答案 0 :(得分:0)

我尝试像这样改变它仍然得到错误错配


Sub Cari()
    Dim sCol As String
    Dim rgFind As Range, rgData As Range, rgCell As Range
    Dim iCol As Integer
    Dim lRow As Long
    Dim vCrit As Date
    Dim vCrit1 As Date
    Dim rSearch As Range

Range(Range("m8"), Range("m8").End(xlToRight).End(xlDown)).ClearContents
sCol = Range("n3").Value
Set rgFind = Range("a2:j2").Find(sCol, lookat:=xlWhole, MatchCase:=True)
iCol = rgFind.Column
lRow = Range("a2").CurrentRegion.Rows.Count
vCrit = CDate(Range("N5"))
vCrit1 = CDate(Range("N6"))
Set rgData = Range(Cells(3, iCol), Cells(lRow, iCol))
Set rSearch = Sheet1.Range("E10", Sheet1.Range("E" & Rows.Count).End(xlUp))
For Each rgCell In rgData
    'Set rgFind = rgCell.Find(vCrit, lookat:=xlPart, MatchCase:=False)
    'If Not rgFind Is Nothing Then
    If rSearch >= vCrit Or rSearch <= vCrit1 Then
        Range(Cells(rgCell.Row, 1), Cells(rgCell.Row, 10)).Copy
        Cells(Rows.Count, 13).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False
    End If
Next rgCell
Range("n5").Select

End Sub

答案 1 :(得分:0)

.Find与日期结合使用时必须小心:使用CDate函数定义搜索日期,并确保日期格式与Excel的默认设置相匹配。有关详细信息,请参阅此帖子:VBA, goto cell with a certain value (type: date)

您会从帖子中看到我更喜欢使用纯VBA和.Value2属性搜索日期。此属性在Excel Long值中提供日期,这意味着该属性不会随日期格式而更改。优点是摆弄格式等的用户不能扰乱您的搜索引擎。这也意味着您可以设置更复杂的匹配条件,例如日期范围内的日期或省略特定日期。

以下是纯VBA搜索引擎如何为您工作的示例。您必须调整数据参数以适合您自己的Worksheet,但我希望这些评论将为您解释每个步骤。确保以全新的Workbook运行它,因为它在Sheet1上写了一些示例数据:

Option Explicit
Public Sub SearchDate()
    Dim dataRng As Range
    Dim v As Variant
    Dim r As Long
    Dim date1 As Date
    Dim date2 As Date
    Dim dateVal1 As Long
    Dim dateVal2 As Long
    Dim found As Boolean

    'Write some sample data to the worksheet -
    CreateSampleData ' call this routine just once

    'Read the data into a variant array
    With ThisWorkbook.Worksheets("Sheet1")
        r = .Cells(.Rows.Count, "B").End(xlUp).Row
        Set dataRng = .Range(.Cells(3, "B"), .Cells(r, "C"))
        v = dataRng.Value2
    End With

    'Set some sample dates
    date1 = #1/20/2016#
    date2 = #2/20/2016#

    'Convert the dates to Excel's date values
    dateVal1 = CLng(date1)
    dateVal2 = CLng(date2)

    'Loop through the dates to find the first within the date range
    found = False
    For r = 1 To UBound(v, 1)
        If v(r, 1) >= dateVal1 And v(r, 1) <= dateVal2 Then
            MsgBox v(r, 2)
            found = True
            Exit For
        End If
    Next

    If Not found Then MsgBox "No date."

End Sub

Private Sub CreateSampleData()
    Dim sample(1 To 101, 1 To 2) As Variant
    Dim dateVal As Long
    Dim i As Integer

    'Create some sample data where
    'column B has 100 dates and
    'column C has a string simulating the data.
    'This will write the data to "Sheet1" so make sure
    'you use a new workbook.

    sample(1, 1) = "Date"
    sample(1, 2) = "Item"
    dateVal = DateSerial(2016, 1, 1)
    For i = 2 To 101
        sample(i, 1) = dateVal
        sample(i, 2) = "Day " & i - 1 & " data"
        dateVal = dateVal + 1
    Next

    ThisWorkbook.Worksheets("Sheet1") _
        .Range("B2:C102").value = sample

End Sub