Сравните два CSV-документа, используя VBA Copy-Paste Script.

Question

с недели я пытаюсь добиться успеха в своей теме, но не могу найти приемлемого решения. Я имею в виду, ... у меня есть рабочее решение, но сравнение занимает около половины дня: -S

Предпосылка: Оба csv-файла уже скопированы в локальную книгу. они присутствуют и готовы играть с ними. каждый файл имеет ~ 6000 строк и 4 столбца. столбец A: название документа / версия колонка B: тема1 колонка C: subject2 колонка D: логический артефакт оба CSV-файла имеют одинаковую структуру. столбец A содержит имя документа и его последнюю версию. каждая строка содержит комбинацию: имя документа / версия, subj1, subj2, логическое значение

Примеры новых CSV_old, включая комментарии / изменения для csv_new в column_E

Document/Version    Subj1   Subj2   BOOLEAN 
DOC_1/Vers1         FUN     GERMANY FALSE   
DOC_2/Vers3         FUN     GERMANY TRUE    
DOC_2/Vers3         FUN     UK      TRUE    <- to be deleted in CSV_new
DOC_2/Vers3         FUN     FRANCE  TRUE    
DOC_3/Vers7         ACTION  GERMANY FALSE   <- Version Update in CSV_new
DOC_4/Vers4         MOVIE   UK      TRUE    
DOC_6/Vers1         HELP    SPAIN   FALSE   
DOC_7/Vers2         FUN     GERMANY FALSE   <- boolean: true in CSV_new
DOC_8/Vers5         FUN FRANCE  TRUE    <- Subj1: ACTION instead of FUN

CSV_new

Document/Version    Subj1   Subj2   BOOLEAN 
DOC_1/Vers1         FUN     GERMANY FALSE   
DOC_2/Vers3         FUN     GERMANY TRUE    
DOC_2/Vers3         FUN     UK      TRUE    
DOC_2/Vers3         FUN     FRANCE  TRUE    
DOC_3/Vers9         ACTION  GERMANY FALSE   <- Version Updated
DOC_4/Vers4         MOVIE   UK      TRUE    
DOC_5/Vers5         DANGER  UK      FALSE   <- new/added Row in CSV_new
DOC_6/Vers1         HELP    SPAIN   FALSE   
DOC_7/Vers2         FUN     GERMANY FALSE   <- boolean updated to true
DOC_8/Vers5         ACTION  FRANCE  TRUE    <- Subj1: ACTION instead of FUN

Цель: Сравните два файла CSV (оба получены из базы данных). Каждый файл является производной версией из огромной базы данных (выдержка). Я хотел бы проверить старый CSV-файл (например, версия 2.0, csv_old) с более новым (например, версия 4.1, csv_new).

Таким образом, я хотел бы увидеть различия между обеими производными версиями (выдержками) базы данных. Могут быть новые вставленные / добавленные строки, а также удаленные строки.

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

Для rowInOldCSV = 3 к листам ("_ ws_oldCSV"). Диапазон ("A65536"). Конец (xlUp). Строка

Set findSameDocumentNumberInColumnA = Sheets(givenActiveWS).Cells.Find(Sheets("_ws_oldCSV").Range("A" & rowInOldCSV & ":D" & rowInOldCSV).Value, LookIn:=xlValues)
Set findSameDocumentNumberInColumnA_withoutVers = Sheets(givenActiveWS).Cells.Find(Left(Sheets("_ws_oldCSV").Cells(rowInOldCSV, 1).Value, Len(Sheets("_ws_oldCSV").Cells(rowInOldCSV, 1).Value) - 5), LookIn:=xlValues)


If Not findSameDocumentNumberInColumnA Is Nothing Then
    'document/version found!

    firstAddress = findSameDocumentNumberInColumnA.Address
    Do
         'if subj1+subj2 are same
        If (Sheets(givenActiveWS).Cells(findSameDocumentNumberInColumnA.Row, 2).Value = Sheets("_ws_oldCSV").Cells(rowInOldCSV, 2).Value) And _
           (Sheets(givenActiveWS).Cells(findSameDocumentNumberInColumnA.Row, 3).Value = Sheets("_ws_oldCSV").Cells(rowInOldCSV, 3).Value) Then '....and boolean-value the same

            'Sheets("_ws_oldCSV").Range("A" & rowInOldCSV & ":D" & rowInOldCSV).Copy 'takes even longer
            'Sheets(givenActiveWS).Cells(findSameDocumentNumberInColumnA.Row, 6).PasteSpecial Paste:=xlPasteValues
            Sheets(givenActiveWS).Cells(findSameDocumentNumberInColumnA.Row, 6).Value = Sheets("_ws_oldCSV").Cells(rowInOldCSV, 1).Value
            Sheets(givenActiveWS).Cells(findSameDocumentNumberInColumnA.Row, 7).Value = Sheets("_ws_oldCSV").Cells(rowInOldCSV, 2).Value
            Sheets(givenActiveWS).Cells(findSameDocumentNumberInColumnA.Row, 8).Value = Sheets("_ws_oldCSV").Cells(rowInOldCSV, 3).Value
            Sheets(givenActiveWS).Cells(findSameDocumentNumberInColumnA.Row, 9).Value = Sheets("_ws_oldCSV").Cells(rowInOldCSV, 4).Value

            'leave loop
            Exit Do
        End If
        Set findSameDocumentNumberInColumnA = Sheets(givenActiveWS).Cells.FindNext(findSameDocumentNumberInColumnA)
    Loop While Not findSameDocumentNumberInColumnA Is Nothing And findSameDocumentNumberInColumnA.Address <> firstAddress

Else
    'document/version not found
    If Not findSameDocumentNumberInColumnA_withoutVers Is Nothing Then
        'document found, looks like new version
        'mark it with yellow to show updated version
    Else
        'unkown document, means  new introduced since csv_old
        'copy it under last item in RowF
        '
    End If
End If
next rowInOldCSV

Пока что до моего подхода. Я видел два разных: http://www.ms -office-forum.net / форум / showthread.php? Т = 279399 а также Excel VBA: диапазон до строкового массива за 1 шаг оба, кажется, работают довольно хорошо и очень быстро, но, к сожалению, я не могу использовать его для моего сценария.

Полагаю, мне нужно поместить значения из столбца в массив строк, чтобы начать сравнение? У меня нет идей, и я понятия не имею, как обрабатывать значения столбцов в массивах строк. Извините, ...

Вы можете мне помочь?

Результат сравнения: было бы неплохо записать материал в CSV_new.

Doc/Vers       Subj1    Subj2    BOOLEAN    Doc    Subj1    Subj1    Boolean
DOC_1/Vers1    FUN      GERMANY  FALSE      -       -       -           -
DOC_2/Vers3    FUN      GERMANY  TRUE       -       -       -           -
DOC_2/Vers3    FUN      UK       TRUE      Deleted  -       -           -
DOC_2/Vers3    FUN      FRANCE   TRUE      -        -       -           -
DOC_3/Vers9    ACTION   GERMANY  FALSE     Updated  -       -           -
DOC_4/Vers4    MOVIE    UK       TRUE      -        -       -           -
DOC_5/Vers5    DANGER   UK       FALSE     New      -       -           -
DOC_6/Vers1    HELP     SPAIN    FALSE     -        -       -           -
DOC_7/Vers2    FUN      GERMANY  TRUE      -        -       -           X
DOC_8/Vers5    ACTION   FRANCE   TRUE      -        X       -           -

Большое, большое спасибо заранее за ваши усилия !!!!! : О)

Answer 1

Этот код сгенерирует 2 набора результатов: один для Sheet1 (старый), другой для Sheet2 (новый)

• Set 1 - Sheet1 покажет записи missing from Sheet2
• Set 2 - Sheet2 покажет записи missing from Sheet1
• В обоих наборах будут отображаться обновленные записи

Используются вложенные словари (подробности ниже)

---

Option Explicit

Public Sub CompareCSVs()    '1 = Old, 2 = New; UsedRange starts at A1

    Const LC1 = 4           'D - LastCol in Old
    Const LC2 = 4           'D - LastCol in New

    Dim ur1 As Range, arr1 As Variant, dv1 As Object
    Dim ur2 As Range, arr2 As Variant, dv2 As Object

    Set ur1 = Sheet1.UsedRange  'Or: ThisWorkbook.Worksheets("csv_old").UsedRange
    Set ur2 = Sheet2.UsedRange  'Or: ThisWorkbook.Worksheets("csv_new").UsedRange
    arr1 = ur1
    arr2 = ur2
    Set dv1 = CreateObject("Scripting.Dictionary")
    Set dv2 = CreateObject("Scripting.Dictionary")

    Dim urRes1 As Range, urRes2 As Range, arrRes1 As Variant, arrRes2 As Variant

    Set urRes1 = ur1.Offset(1, LC1).Resize(ur1.Rows.Count - 1, LC1 + 1) 'Exclude Headers
    Set urRes2 = ur2.Offset(1, LC2).Resize(ur2.Rows.Count - 1, LC2 + 1) 'Exclude Headers
    urRes1.ClearContents        'Clear results
    urRes2.ClearContents
    arrRes1 = urRes1
    arrRes2 = urRes2

    SetDictionaries dv1, arr1, LC1
    SetDictionaries dv2, arr2, LC2:     'ShowAllItems dv1:   ShowAllItems dv2

    CompareData dv1, dv2, arrRes2
    CompareData dv2, dv1, arrRes1

    urRes1 = arrRes1
    urRes2 = arrRes2
End Sub

---

Private Sub SetDictionaries(ByRef d As Object, ByRef arr As Variant, ByVal ubC As Long)

    Dim r As Long, c As Long, k As String

    For r = 2 To UBound(arr)
        For c = 1 To ubC
            k = k & arr(r, c) & "|"
            d(Left(k, Len(k) - 1)) = 0
        Next
        k = vbNullString
    Next
End Sub

Private Sub CompareData(ByRef d1 As Variant, ByRef d2 As Variant, ByRef res As Variant)

    Dim r As Long, c As Long, itm As Variant, sp As Variant, k As Variant

    r = 1
    For Each itm In d2
        sp = Split(itm, "|")
        c = UBound(sp) + 1
        If Not d1.Exists(itm) Then
            If Len(res(r, 1)) = 0 Then
                res(r, 1) = IIf(c = 1, "Missing: ", "Updated: ")
                res(r, c + 1) = sp(c - 1)
            Else
                If res(r, 1) = "Updated: " Then res(r, c + 1) = sp(c - 1)
            End If
        End If
        If c = 4 Then r = r + 1
    Next
End Sub

---

Private Sub ShowAllItems(ByRef d As Object)

    Dim x As Variant

    For Each x In d
        Debug.Print x   'Space$(5), String$(5, "-")
    Next
    Debug.Print
End Sub

---

Словари, когда готовы к сравнению

До

* После 1044 *

Примечание: предоставленные вами образцы данных не совпадают с описанными в описании

CSV_old

Document/Version Subj1  Subj2   BOOLEAN 
DOC_1/Vers1      FUN    GERMANY FALSE                                 <- Correct
DOC_2/Vers3      FUN    GERMANY TRUE                                  <- Correct
DOC_2/Vers3      FUN    UK      TRUE  <- to be deleted in CSV_new     <- Exists in new
DOC_2/Vers3      FUN    FRANCE  TRUE                                  <- Correct
DOC_3/Vers7      ACTION GERMANY FALSE <- Version Update in CSV_new    <- This not in new
DOC_4/Vers4      MOVIE  UK      TRUE                                  <- Correct
DOC_6/Vers1      HELP   SPAIN   FALSE                                 <- Correct  
DOC_7/Vers2      FUN    GERMANY FALSE <- boolean: true in CSV_new     <- FALSE in new
DOC_8/Vers5      FUN    FRANCE  TRUE  <- Subj1: ACTION instead of FUN <- Correct

CSV_new

Document/Version Subj1  Subj2   BOOLEAN 
DOC_1/Vers1      FUN    GERMANY FALSE                                 <- Correct
DOC_2/Vers3      FUN    GERMANY TRUE                                  <- Correct  
DOC_2/Vers3      FUN    UK      TRUE                                  <- Exists in new
DOC_2/Vers3      FUN    FRANCE  TRUE                                  <- Correct   
DOC_3/Vers9      ACTION GERMANY FALSE <- Version Updated              <- New record
DOC_4/Vers4      MOVIE  UK      TRUE                                  <- Correct
DOC_5/Vers5      DANGER UK      FALSE <- new/added Row in CSV_new     <- Correct
DOC_6/Vers1      HELP   SPAIN   FALSE                                 <- Correct
DOC_7/Vers2      FUN    GERMANY FALSE <- boolean updated to true      <- FALSE in new
DOC_8/Vers5      ACTION FRANCE  TRUE  <- Subj1: ACTION instead of FUN <- Correct