将VBA中的日期与偏移量进行比较

时间:2016-04-20 14:26:15

标签: excel vba date

我正在尝试使用以下脚本来比较2个日期,但如果日期间隔超过5天,则仅复制数据。我很确定我的方程式大于给出不正确的结果。

Sub CompareSheets()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

    Dim laws As Worksheet
    Set laws = Sheets("LookAhead")
    Dim galreqws As Worksheet
    Set galreqws = Sheets("Data")

    Dim RowsMaster As Integer, Rows2 As Integer
    RowsMaster = laws.Cells(1048576, 1).End(xlUp).Row
    Rows2 = galreqws.Cells(1048576, 1).End(xlUp).Row
    ' Get the number of used rows for each sheet


    With Worksheets("Data")
        For i = 2 To Rows2
        ' Loop through Sheet 2
            For j = 2 To RowsMaster
            ' Loop through the Master sheet
                If .Cells(i, 10) > laws.Cells(j + 5, 10) Then
                ' If a match is found:
                    laws.Cells(j, 7) = .Cells(i, 7)
                    ' Copy in contact info
                    Exit For
                ElseIf j = RowsMaster Then
                ' If we got to the end of the Master sheet
                    RowsMaster = RowsMaster + 1
                    ' Increment the number of rows
                    For k = 1 To 11 ' Change 3 to however many fields Sheet2 has
                        laws.Cells(RowsMaster, k) = .Cells(i, k)
                        laws.Range(laws.Cells(j + 1, 1), laws.Cells(j + 1, 10)).Interior.ColorIndex = 24
                        ' Copy the data from Sheet2 in on the bottom row of Master
                    Next
                End If
            Next j
        Next i
    End With


Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

2 个答案:

答案 0 :(得分:0)

If .Cells(i, 10) > laws.Cells(j, 10) + 5  Then

我不知道你的数据是怎样的,但试试这个。

答案 1 :(得分:0)

也许一个或多个单元格包含日期以外的内容,因此Excel VBA无法比较它们。这是一个稍微调整(部分)的代码,它可以进行更多的错误处理:

With Worksheets("Data")
    For i = 2 To Rows2
    ' Loop through Sheet 2
        For j = 2 To RowsMaster
        ' Loop through the Master sheet
            If IsDate(.Cells(i, 10).Value) And IsDate(laws.Cells(j, 10).Value) Then
                If CDate(.Cells(i, 10).Value) > CDate(laws.Cells(j, 10).Value + 5) Then
                ' If a match is found:
                    laws.Cells(j, 7).Value2 = .Cells(i, 7).Value2
                    ' Copy in contact info
                    Exit For
                ElseIf j = RowsMaster Then
                ' If we got to the end of the Master sheet
                    RowsMaster = RowsMaster + 1
                    ' Increment the number of rows
                    For k = 1 To 11 ' Change 3 to however many fields Sheet2 has
                        laws.Cells(RowsMaster, k).Value2 = .Cells(i, k).Value2
                        laws.Range(laws.Cells(j + 1, 1), laws.Cells(j + 1, 10)).Interior.ColorIndex = 24
                        ' Copy the data from Sheet2 in on the bottom row of Master
                    Next
                End If
            Else
                MsgBox "Cannot compare " & .Cells(i, 10).Value & " to " & laws.Cells(j, 10).Value & "."
            End If
        Next j
    Next i
End With

尝试一下,让我知道这是否有效。