Question

我正在使用在完成共享点调查后刷新的数据集，然后将对该调查的响应导出到Excel中的表中。如果所检查的设施（Y列）的邮政编码（字符串）相同，则我希望能够删除整行，但是我想保留最新的调查答复，或在调查答复中显示的答复。行值更高。

例如，第38行包含邮政编码为“ 33138”的调查答复。第52行（最近完成了调查）的邮政编码也为“ 33138”。我想删除第38行，并保留第52行。

寻找VBA解决方案。

@BigBen我尝试了这段代码，我在几个讨论板上找到了它。还请注意，我计划从“仪表板”选项卡上的按钮运行此操作，以获取“数据”选项卡上的记录。

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

@BigBen，作为较长脚本的一部分，我还尝试了以下代码。这种方法行得通，但是只删除了重复项的第一个实例，而不是所有重复行。

Worksheets("Data").Activate
Dim lrow As Long

For lrow = Cells(Rows.Count, "Y").End(xlUp).Row To 2 Step -1
    If Cells(lrow, "Y") = Cells(lrow, "Y").Offset(-1, 0) Then
       Cells(lrow, "Y").Offset(-1, 0).EntireRow.Delete
    End If

Next lrow

Answer 1

根据您的评论，数据位于表（ListObject）中，这样的操作可能会起作用。这将从第一行循环到最后一行，如果使用当前行的值在列上的CountIf大于1，则删除该行。

Sub DedupeZipCodes()
    Dim tbl As ListObject: Set tbl = ThisWorkbook.Sheets("Data").ListObjects("Table1")
    Dim zipCol As ListColumn: Set zipCol = tbl.ListColumns("Zip Code")
    Dim currentRow As Long, lastRow As Long

    With zipCol
        currentRow = 1
        lastRow = .DataBodyRange.Rows.Count

        Do While currentRow < lastRow
            If Application.CountIf(.DataBodyRange, .DataBodyRange(currentRow).Value) > 1 Then
                .DataBodyRange(currentRow).EntireRow.Delete
                lastRow = .DataBodyRange.Rows.Count
            Else
                currentRow = currentRow + 1
            End If
        Loop

    End With
End Sub

根据Y列中的重复项删除整行并保留最后一条记录

1 个答案: