Excel VBA - 如何比较不同格式的日期答案

【问题标题】：Excel VBA - How can dates of different formats be comparedExcel VBA - 如何比较不同格式的日期
【发布时间】：2021-05-22 18:03:48
【问题描述】：

我正在尝试比较两个不同格式的不同工作表中的日期。第一张的格式是 YYYYMMDD，第二张的格式是 DD/MM/YYYY。

需要注意的是，第二张工作表的年份不正确（写为 2020，应该是 2021）。这些行也可以是不同的顺序。第一个工作表的日期数据输入为文本而不是日期。

尽我所能，我无法更改这两张纸上的数据，而只能输出到第三张纸（基本上检查数据是否有相同日期的条目，不计算错误的年份，如果它们之间的某些关键数据不同，则输出一些东西。

例如，如果一张纸有...

Date	Price
20210101	500
20210102	1000
20210103	2000

...另一个有...

Date	Price
01/01/2020	500
03/01/2020	3000
02/01/2020	750

...我想把它输出到第三张纸上...

Date	Sheet 1 Price	Sheet 2 Price
20210102	1000	750
20210103	2000	3000

我有一些原则上可以使用的 VBA 代码，但前提是格式相同。

' the columns to check in the first worksheet
Const ws1Date As Integer = 1          'first worksheet, Column A
Const ws1Price As Integer = 2         'first worksheet, Column B

' the columns to check in the second worksheet
Const ws2Date As Integer = 1         'second worksheet, Column A
Const ws2Price As Integer = 2        'second worksheet, Column B

' the columns to write to in the result worksheet
Const resultWsDate As Integer = 1          'result worksheet, Column A
Const resultWsPrice As Integer = 2         'result worksheet, Column B
Const resultWsClientPrice As Integer = 3   'result worksheet, Column C

Dim ws1DateArray As Variant, ws2DateArray As Variant
Dim ws1 As Worksheet, ws2 As Worksheet, resultWs As Worksheet

Set ws1 = Sheets(1) 'the first worksheet
Set ws1 = Sheets(2) 'the second worksheet
Set resultWs = Sheets(3) 'the outputted results

Sub compareFiles()

'-- Store ws1 dates in array --
compareRowMaxLength = ws1.Cells(Rows.Count, ws1Date).End(xlUp).Row
ws1DateArray = ws1.Range(Cells(1, ws1Date).Address, _
                       Cells(compareRowMaxLength, ws1Date).Address).Value
                       
'-- Store ws2 dates in array --
compareRowMaxLength = ws2.Cells(Rows.Count, ws2Date).End(xlUp).Row
ws2DateArray = ws2.Range(Cells(1, ws2Date).Address, _
                       Cells(compareRowMaxLength, ws2Date).Address).Value

'-- Store ws1 depth in array --
compareRowMaxLength = resultWs.Cells(Rows.Count, ws1Date).End(xlUp).Row
ws1DepthArray = resultWs.Range(Cells(1, ws1Date).Address, _
                       Cells(compareRowMaxLength, ws1Depth).Address).Value

'-- Interate through arrays --
For compareRow = 2 To UBound(ws2DateArray, 1)
    matchData = 0
    On Error Resume Next
    
    matchData = WorksheetFunction.Match(ws2DateArray(compareRow, 1), ws1DateArray, 0)
    On Error GoTo 0
    ' if the date of the current row is found in the second sheet
    If matchData <> 0 Then
        If ws2.Cells(compareRow, ws2Price).Value <> ws1.Cells(matchData, ws1Price).Value Then
            ' Copy the matching data to the results worksheet
            resultWs.Cells(resultRow, resultWsDate).Value = ws1.Cells(matchData, ws1Date).Value
            resultWs.Cells(resultRow, resultWsPrice).Value = ws1.Cells(matchData, ws1Price).Value
            resultWs.Cells(resultRow, resultWsClientPrice).Value = ws2.Cells(compareRow, ws2Price).Value
        End If
    End If
Next compareRow

End Sub

我试图在 For 循环中使用类似的东西重新格式化工作表 2 中的日期...

    ReplacementYear = 2021
    
    FormatDay = Left(ws2DateArray(compareRow, 1), 2)
    FormatMonth = Mid(ws2DateArray(compareRow, 1), 4, 2)
    FormattedDate = CStr(ReplacementYear) + CStr(FormatMonth) + CStr(FormatDay)

...并将 matchData = WorksheetFunction.Match(ws2DateArray(compareRow, 1), ws1DateArray, 0) 更改为 matchData = WorksheetFunction.Match(FormatDate, ws1DateArray, 0) 但似乎 Match 无法以这种方式工作。

非常感谢您的帮助！

【问题讨论】：

这些日期是如何存储的？ Excel 将“真实日期”存储为以1-Jan-1900 开头的序列号。如果两者都是“真实日期”并且只是格式不同，请比较 .Value2 属性（它应该是 Double 或 Long，不是 INTEGER）。如果差异是数据类型而不是格式，建议您转换为真实日期，然后进行比较。
当您单击具有20210102 的单元格时，请检查编辑栏。你看到了什么？
@RonRosenfeld 第一个工作表将日期存储为文本，而不是“真实日期”。但是，第二张纸确实将其作为日期进行了排序。谢谢，我试试看能不能做到。我根本无法修改第一个工作表（实际上两者都是单独的工作簿，我只能查看而不能编辑，将其拉入第三个工作簿的报告中），因此我必须通过宏对其进行转换。 @SiddharthRout 第一张是20210102（输入为文本），第二张是02/01/2020（输入为日期）。
您必须将其转换为真实日期才能进行直接比较。使用DateSerial(Left(Range("A1").Value2, 4), Mid(Range("A1").Value2, 5, 2), Right(Range("A1").Value2, 2)) 将20210102 转换为日期进行比较
如果您有兴趣，以上所有操作也可以在 Power Query 中完成。它确实需要为您的 sheet1 和 sheet2 数据使用表格。

标签： excel vba

【解决方案1】：

这可能不是最好的解决方案，但如果这对未来的任何人都有帮助，这就是我想出的。

我无法修改其他工作表中的数据，但我可以将数据复制到新工作表中，进行修改，然后稍后将其删除。

' copy the worksheets and modify dates
ws1.Copy After:=Sheets(4)
ws2.Copy After:=Sheets(5)

Set modifyWs1 = Sheets(4)
Set modifyWs2 = Sheets(5)

' fix dates and apply consistent formatting to dates and depth
modifyWs1 .Activate

Dim ws1DateCol As Range

For Each ws1DateCol In Range(Range("A2"), Range("A2").End(xlDown))
    ws1DateCol.NumberFormat = "yyyymmdd" ' confirm date format
    ws1DateCol.Value = ws1DateCol.Text ' change cells to text so they can be Matched
    ws1DateCol.NumberFormat = "@"
Next

' fix dates and apply consistent formatting to dates and depth
modifyWs2.Activate

Dim ws2DateCol As Range

For Each ws2DateCol In Range(Range("A2"), Range("A2").End(xlDown))
    ws2DateCol.Value = DateAdd("yyyy", 1, ws2DateCol.Value) ' add 1 to the year, as 2020 should be 2021
    ws2DateCol.NumberFormat = "yyyymmdd" ' change date format
    ws2DateCol.Value = ws2DateCol.Text ' change cells to text so they can be Matched
    ws2DateCol.NumberFormat = "@"
Next

然后将这些新列中的数据放入 ws1DateArray 和 ws2DateArray 中，而 WorksheetFunction.Match(ws2DateArray(compareRow, 1), ws1DateArray, 0) 将按需要工作。

【讨论】：