Excel / VBA удаление повторяющихся строк с нескольких листов

В настоящее время я получаю ежемесячный дамп из одной из наших баз данных, которая содержит все наши активные подписки на общественный транспорт. Моя задача - загрузить их в SAP, но только те значения, которые отличаются по сравнению с прошлым месяцем. Таким образом, все новые подписки должны быть получены, и все подписки, для которых одно из значений в одном из разных столбцов отличается по сравнению с прошлым месяцем. Если ряд точно такой же, мне он не нужен.

Полученный мной файл содержит 7 столбцов, столбец A содержит уникальный ключ для каждого сотрудника.

Я хотел бы использовать VBA для сравнения двух файлов Excel, вставив файл из прошлого месяца в Sheet1 и файл этого месяца в Sheet2. Я хочу найти те строки, которые равны, и удалить их из Sheet2.

Я уже нашел несколько примеров кодов VBA, делающих это, но, похоже, ничего не работает должным образом. Тот, который я использовал ниже, является последним, который я использовал, что дало мне синтаксическую ошибку в следующей строке кода Do While Not IsEmpty(wsA.Range(keyColA & intRowCounterA).Value).

Sub CleanDupes()
Dim wsA As Worksheet
Dim wsB As Worksheet
Dim keyColA As String
Dim keyColB As String
Dim rngA As Range
Dim rngB As Range
Dim intRowCounterA As Integer
Dim intRowCounterB As Integer
Dim strValueA As String


keyColA = "A"
keyColB = "B"

intRowCounterA = 1
intRowCounterB = 1

Set wsA = Worksheets("Sheet1")
Set wsB = Worksheets("Sheet2")

Do While Not IsEmpty(wsA.Range(keyColA & intRowCounterA).Value)
    intRowCounterB = 1
    Set rngA = wsA.Range(keyColA & intRowCounterA)
    strValueA = rngA.Value
    Do While Not IsEmpty(wsB.Range(keyColB & intRowCounterB).Value
        Set rngB = wsB.Range(keyColB & intRowCounterB)
        If strValueA = rngB.Value Then
             'Code to delete row goes here, but I'm not sure exactly'
             'what it is.'
             wsB.Range(Rows(intRowCounterB)).EntireRow.Delete
             intRowCounterB = intRowCounterB - 1
        End If
        intRowCounterB = intRowCounterB + 1
    Loop
    intRowCounterA = intRowCounterA + 1
Loop

Конец подписки

Любые идеи?

Ник


duplicates excel vba
person Nick    schedule 24.04.2018    source источник
comment
Если вы пробовали код, который не сработал, вы должны включить его в свой пост и объяснить, как именно он не сработал.   -  person Tim Williams    schedule 24.04.2018
comment
Извините, но все еще новичок в VBA и на этом сайте. Я обновил свой исходный вопрос.   -  person Nick    schedule 24.04.2018

Ответы (1)


arrow_upward
0
arrow_downward

Приведенный ниже код находит повторяющиеся строки из Sheet1 в Sheet2. Он сравнивает все значения строк в Sheet1.Row(id) конкатенированных, со всеми значениями строк в Sheet2.Row(id) конкатенированных

В конце он перемещает дубликаты на новый лист с шаблоном имени "Sheet2 Dupes - yyyymmdd-hhmmss" (текущая дата и время).

Public Sub RemoveDuplicateRows()
    Dim ur1 As Range, ur2 As Range, dupeRows As Range
    Dim r1 As Range, s1 As String, r2 As Range, s2 As String

    Set ur1 = Worksheets("Sheet1").UsedRange.Rows
    Set ur2 = Worksheets("Sheet2").UsedRange.Rows  'Find duplicates from Sheet1 in Sheet2

    Set dupeRows = ur2(Worksheets("Sheet2").UsedRange.Rows.Count + 1)
    For Each r1 In ur1
        s1 = Join(Application.Transpose(Application.Transpose(r1)))
        For Each r2 In ur2
            s2 = Join(Application.Transpose(Application.Transpose(r2)))
            If s1 = s2 Then
                If Intersect(dupeRows, r2) Is Nothing Then
                    Set dupeRows = Union(dupeRows, r2)
                End If
            End If
        Next
    Next

    Dim wb As Workbook, wsDupes As Worksheet    'Move duplicate rows to new Sheet
    Application.ScreenUpdating = False
    Set wb = ThisWorkbook
    Set wsDupes = wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count))
    wsDupes.Name = "Sheet2 Dupes - " & Format(Now, "yyyymmdd-hhmmss")
    dupeRows.Copy
    With wsDupes.Cells(1)
        .PasteSpecial xlPasteAll
        .PasteSpecial xlPasteColumnWidths
        .Select
    End With
    dupeRows.EntireRow.Delete
    Application.ScreenUpdating = True
End Sub
person user9770531    schedule 26.04.2018
comment
Привет, большое спасибо за ответ! Кажется, работает, удалив все дубликаты. Вы знаете, можно ли поместить различия на новом листе вместо того, чтобы удалять их на Sheet2? - person Nick; 22.05.2018
comment
Привет, я обновил ответ, чтобы переместить повторяющиеся строки на новый лист - person user9770531; 24.05.2018
comment
Привет, Ваш отзыв очень важен. Я попробовал код, который вы предоставили, однако новый лист не заполняется, и я думаю, что я недостаточно ясно изложил свое объяснение. Я хочу оставить Sheet1 и Sheet2 как есть, и я хочу, чтобы различия были записаны на Sheet3. Таким образом, никакого удаления дубликатов, просто запись уникальных значений в Sheet3. - person Nick; 24.05.2018