Question

我需要一些宏的帮助，我不确定从哪里开始，因为我对此很陌生。我将在列＃34; A＆＃34;中列出数据/参考号。从＆＃34; A7＆＃34;开始。其中许多参考编号都有重复数据。（主要是2个重复）

虽然，在某些情况下我会有3或4个相同参考编号的副本。我需要一个宏来搜索重复值在列＆＃34; A＆＃34;出现两次以上并删除它们和它们所在的行，同时保留第一个和最后一个实例。

我希望我能清楚地解释清楚这一点。我附上了下面一个例子的快照。

专栏＆＃34; A＆＃34;通过＆＃34; C＆＃34;包含一个数据集，它包含一个实例，其中有三个实例。（以红色文字突出显示）我想要的最终结果显示在列＆＃34; G＆＃34;通过＆＃34;我＆＃34;。

请注意，这需要使用宏/ VBA完成，并且每次运行此宏时，列和行中的数据长度可能会有所不同，因此需要应用到上次使用的行和列。

非常感谢任何帮助！

这是我应用的基本脚本，但问题是它会删除所有重复项。 Sub Dup（）

M = Cells(Rows.Count, "A").End(xlUp).Row

For i = M To 7 Step -1
        Set rlook = Range(Cells(i - 1, "A"), Cells(7, 1))
        If Application.WorksheetFunction.CountIf(rlook, Cells(i, "A")) > 0 Then
            Cells(i, "A").clear
        End If
    Next i
End Sub

感谢

Answer 1

您需要查看上一行值和下一行值。如果前一行的值与当前行的值相同，则下一行的值也是......这是第3次+记录。

If (Current = Previous) AND (Current = Next) Then
Cells(i, "A").clear
End if

Answer 2

这应该适合你：

Sub DeleteDuplicates()
Dim lRow As Long
Dim i, j, k As Integer
Dim Duplicates() As Integer
Dim sht As Worksheet
Dim Val1, Val2 As String

Set sht = Worksheets("Sheet1")

lRow = sht.Cells(Rows.Count, 1).End(xlUp).Row
Index = 0

For i = 7 To lRow
    Val1 = sht.Cells(i, 1).Value
    Index = 0
    For j = i + 1 To lRow
        Val2 = sht.Cells(j, 1).Value
        If Val1 = Val2 Then
            ReDim Preserve Duplicates(Index)
            Duplicates(Index) = j
            Index = Index + 1
        End If
        If j = lRow Then
            If Index > 1 Then
                For k = UBound(Duplicates) - 1 To 0 Step -1
                    sht.Rows(Duplicates(k)).EntireRow.Delete
                Next k
            End If
        End If
    Next j
Next i
End Sub

Answer 3

使用词典保存最后一个值出现的最后一行，以便在再次找到时将其添加到已删除的范围。诀窍是，如果它是第一个外观，请不要保存：首次出现时，在字典中输入零而不是行号，这样就可以避免删除第一个外观。

Sub keepFirstAndLast()
  Dim toDelete As Range: Set toDelete = Sheet1.Rows(999999) '(to not start with a null range)
  Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")

  Dim a As Range
  For Each a In Sheet1.Range("A7", Sheet1.Range("A999999").End(xlUp))
    If Not dict.Exists(a.Value2) Then
      dict(a.Value2) = 0 ' first appearence, dont save the row
    Else
      ' if last observed occurrence was a duplicate, add it to deleted range
      If dict(a.Value2) > 0 Then Set toDelete = Union(toDelete, Sheet1.Rows(dict(a.Value2)))
      dict(a.Value2) = a.row ' not first appearence, save the row for eventual deletion
    End If
  Next
  toDelete.Delete
End Sub

删除重复EXCEL VBA宏

3 个答案: