VBA .Find,日期,序列号日期和数据类型属性(.Text,.Value,.Value2)

时间:2016-01-27 04:27:09

标签: excel vba excel-vba date

使用Range.Find方法迭代一个范围中的每个值,以查看它是否存在于另一个范围内。问题是两个范围的格式不同(但所有值都是表面上的日期),这导致许多“假阴性”(即,值应该是不匹配的)。是否可以控制输入和搜索范围的数据类型,以便系统比较苹果与苹果之间的成功并识别匹配?

以下是数据和代码:

Sheet1 (custom format, "yyyy-mm-dd")  
A1  2016-01-01  
A2  2016-01-02  
A3  2016-01-03  
A4  2016-01-04  
A5  2016-01-05  

Sheet2 (text format)  
A1  2016-01-01  
A2  2016-01-03  
A3  2016-01-05  

Sheet3 (display as "yyyy-mm-dd")  
[NO DATA]  

Sheet4 (display as "yyyy-mm-dd")   
[NO DATA]  

代码:

 Sub FindTest()  
            Dim inputRange As Range  
            Dim searchRange As Range  
            Dim found As Range  
            Set inputRange = Worksheets(1).Cells(1, 1).Resize(7, 1)  
            Set searchRange = Worksheets(2).Cells(1, 1).Resize(5, 1)  
            For Each i In inputRange  
                Set found = searchRange.Find _  
                    (What:=i, _  
                    after:=Cells(1, 1), _  
                    LookIn:=xlValues, _  
                    LookAt:=xlWhole, _  
                    SearchOrder:=xlByRows, _  
                    SearchDirection:=xlNext, _  
                    MatchCase:=False, _  
                    SearchFormat:=False)  
                If Not (found Is Nothing) Then  
                    Worksheets(3).Cells(i.Row, i.Column) = i  
                Else  
                    Worksheets(4).Cells(i.Row, i.Column) = i  
                End If  
            Next i  
        End Sub  

为了实现这一点,我假设我需要将inputRange和searchRange中的所有值作为.Text进行比较,但我不确定是否会到达那里。

2 个答案:

答案 0 :(得分:1)

如果您需要将数据保存为真实日期和文本 - 看起来像日期,那么请格式化他在飞行中的真实日期值,以找到'text-dates'中的匹配项。

Sub FindTest()
    Dim inputRange As Range, i As Range
    Dim searchRange As Range, found As Range

    Set inputRange = Worksheets(1).Cells(2, 1).Resize(99, 1)
    Set searchRange = Worksheets(2).Columns(1)

    For Each i In inputRange
        If IsDate(i) Then                      ' ▼ format into TXT  here ▼
            Set found = searchRange.Find(What:=Format(i.Value2, "yyyy-mm-dd"), _
                            after:=Cells(1), LookIn:=xlValues, LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                            MatchCase:=False, SearchFormat:=False)
            If Not (found Is Nothing) Then
                With Worksheets(3)
                    .Cells(i.Row, i.Column) = i.Address(external:=True)
                    .Cells(i.Row, i.Column + 1) = i.Address(external:=True)
                End With
            Else
                With Worksheets(4)
                    .Cells(i.Row, i.Column) = i.Address(external:=True)
                    .Cells(i.Row, i.Column + 1) = i.Address(external:=True)
                End With
            End If
        End If
    Next i
End Sub

或者,Range.Text property应提供相同的答案。应用Trim命令以确保inputRange日期未使用格式掩码中的尾随_)进行格式化。

        Set found = searchRange.Find(What:=Trim(i.Text), _
                        after:=Cells(1), LookIn:=xlValues, LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                        MatchCase:=False, SearchFormat:=False)

附录:

如果searchRange中有空格或尾随空格的可能性,请将搜索参数更改为LookAt:=xlPart。虽然事先修复数据仍然是更好的选择,但它会忽略可能干扰成功匹配的无关字符。

如果修复数据可视为一个选项,那么对带有YMD Range.TextToColumns method的文字值进行全面xlColumnDataType会将您的yyyy-mm-dd'文字日期'快速转换为实际日期。

    With searchRange
        .TextToColumns Destination: .Cells (1), DataType:=xlFixedWidth, _
                       FieldInfo:=Array(0, 5)
    End With

这将删除前导/尾随无关字符,并为您留下一列真实日期。

答案 1 :(得分:0)

TextToColumn代码(不成功)

Sub FindTest()
Dim inputRange As Range
Dim i As Range
Dim searchRange As Range
Dim found As Range
Set inputRange = Worksheets(1).Cells(1, 1).Resize(7, 1)
Set searchRange = Worksheets(2).Cells(1, 1).Resize(5, 1)
searchRange.TextToColumns Destination:=Worksheets(2).Cells(1), DataType:=xlDelimited, FieldInfo:=Array(1, xlTextFormat)
For Each i In inputRange
    Set found = searchRange.Find _
        (What:=i, _
        after:=Cells(1, 1), _
        LookIn:=xlValues, _
        LookAt:=xlWhole, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=False, _
        SearchFormat:=False)
    If Not (found Is Nothing) Then
        Worksheets(3).Cells(i.Row, i.Column) = i
    Else
        Worksheets(4).Cells(i.Row, i.Column) = i
    End If
Next i

End Sub