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

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

0 голосов
/ 24 апреля 2018

В настоящее время я получаю ежемесячный дамп из одной из наших баз данных, которая содержит все наши активные подписки на общественный транспорт.Моя задача - загрузить их в 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

End Sub

Есть идеи?

Ник

1 Ответ

0 голосов
/ 26 апреля 2018

Код ниже находит повторяющиеся строки из 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
...