Удаление дубликатов и замена записей подряд - Excel VBA - PullRequest
Новая
       19

Удаление дубликатов и замена записей подряд - Excel VBA

0 голосов
/ 11 февраля 2019

В этом проекте я надеюсь удалить дубликаты на основе идентификационного номера, сохранив последние записи.Кроме того, я хочу сохранить каждую ячейку в столбце D и далее из предыдущих записей.В конечном итоге это означает, что самые последние записи будут заменены в строке предыдущих записей.Пожалуйста, смотрите таблицы ниже для большей ясности:

Example of results before and after macro

На основании приведенного выше примера, я ищу результат:

  • Удалить дубликаты на основе идентификатора из столбцов от A до C и сохранить самые последние записи
  • Сохранить столбцы с D по H из предыдущих записей
  • Заменить предыдущие записи самыми последними встрока предыдущих записей.

Другими словами: Обновите столбцы от A до C без изменения столбцов D до H

Итак, исходный код, который у меня был, был следующим.Он сохранил только предыдущие записи и сохранил столбцы от D до H: 

Sub Delete_Duplicates()
Sheet5.Range("$A$1:$H$29999").RemoveDuplicates Columns:=Array(1) _
    , Header:=xlYes
End Sub

В таблице ниже показано, что я получил бы: Result after first code

Следующий код IЯ должен был сохранить самые новые записи, но это удаляет мои записи в столбце D до H: 

Sub Delete_Duplicates_2()
Dim Rng As Range, Dn As Range, n As Long
Dim Lst As Long, nRng As Range
Set Rng = Sheet5.Range("$A$2:$H$29999")
Lst = Range("A" & Rows.Count).End(xlUp).Row
    With CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
For n = Lst To 1 Step -1
     If Not .Exists(Range("A" & n).Value) Then
        .Add Range("A" & n).Value, Nothing
    Else
        If nRng Is Nothing Then
            Set nRng = Range("A" & n)
        Else
            Set nRng = Union(nRng, Range("A" & n))
        End If
End If
Next n
If Not nRng Is Nothing Then 
nRng.EntireRow.Delete
End With
End Sub

В таблице ниже показано, что я получил бы: enter image description here

Я открыт для любых предложений и благодарю вас за помощь!

1 Ответ

0 голосов
/ 11 февраля 2019

Попробуйте это решение - поскольку вы, по сути, работаете со строкой в ​​столбце даты, мы должны выделить число и проверить, больше ли оно или меньше номера другой недели: 

Option Explicit
Sub Delete_Duplicates()

    Dim i As Long, j As Long
    Dim id As String, weeknum As Long

    For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
        id = Cells(i, 1).Value
        weeknum = Split(Cells(i, 3).Value, " ")(1)

        For j = i - 1 To 2 Step -1
            If Cells(j, 1).Value = id Then
                If Split(Cells(j, 3).Value, " ")(1) < weeknum Then
                    Rows(j).Delete
                    i = i - 1
                Else
                    Rows(i).Delete
                    Exit For
                End If
            End If
        Next j
    Next i

End Sub

img1

...