Блог

Я пытаюсь сравнить даты из двух разных листов, которые имеют разные форматы. Формат первого листа-ГГГГММДД, а второго-ДД/ММ/ГГГГ.

Предостережение заключается в том, что год второго листа неверен (он написан как 2020 и должен быть 2021). Строки также могут располагаться в разных порядках. Данные первого рабочего листа для даты вводятся в виде текста, а не даты.

Как бы мне ни хотелось, я не могу изменить данные на этих двух листах и вместо этого могу выводить только на третий лист (по сути, проверяя данные на наличие записей с той же датой, не считая неправильного года, и выводя что-то, если некоторые ключевые данные отличаются между ними).

Например, если на одном листе есть…

…и у другого есть…

…Я бы хотел вывести это на третий лист…

У меня есть некоторый код 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
 

Я попытался переформатировать дату с листа 2, используя что-то подобное в цикле For…

     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) , но, похоже, Матч не может работать таким образом.

Большое спасибо за любую помощь!

Это вполне может быть не лучшим решением, но на тот случай, если это поможет кому-нибудь в будущем, вот что я придумал.

Я не могу изменить данные на других листах, но я могу скопировать данные на новый лист, изменить его, а затем удалить позже.

 ' 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) работают по желанию.