Question

如果B列中的值为空（即客户与之前的非空行相同），并且如果它们在L列中是重复的，我只需要帮助清除单元格（L，M）的内容每个客户。

例如：

       Customer (B)             Sales (L)    Description (M)
row1   James                     Laptop     Laptop sold
row2                             Laptop     Laptop sold
row3                            Iphone      Iphone sold
row4   Brian                    Iphone      Iphone sold
row5                             Mouse      Mouse sold
row6                             Iphone     Iphone sold

期望的结果：

       Customer (B)             Sales (L)    Description (M)
row1   James                     Laptop     Laptop sold
row2                             
row3                            Iphone      Iphone sold     
row4   Brian                    Iphone      Iphone sold
row5                             Mouse      Mouse sold
row6

Answer 1

您想要的是清除{B}为空白的range(E:F)，range(E:F)与上面的行相同？如果是这种情况，你需要这样的东西：

Sub Testing2()
    Dim x
    For Each c In Range(Range("E1"), Range("E" & Rows.count).End(xlUp))
        If Range("B" & c.row).Value <> "" Then
            x = 1
            Do Until Range("B" & c.row + x).Value <> "" And c.row + x < Range("E" & Rows.count).End(xlUp).row
                Range("E" & c.row).Select
                If Range("E" & c.row).Value = Range("E" & c.row + x).Value And Range("F" & c.row).Value = Range("F" & c.row + x).Value Then
                    Range("E" & c.row + x & ":F" & c.row + x).ClearContents
                End If
                If c.row + x >= Range("E" & Rows.count).End(xlUp).row Then
                    Exit Do
                End If
                x = x + 1
            Loop
        End If
        If Range("B" & c.row).Value = "" Then
            x = 1
            Do Until Range("B" & c.row + x).Value <> "" And c.row + x < Range("E" & Rows.count).End(xlUp).row
                Range("E" & c.row).Select
                If Range("E" & c.row).Value = Range("E" & c.row + x).Value And Range("F" & c.row).Value = Range("F" & c.row + x).Value Then
                    Range("E" & c.row + x & ":F" & c.row + x).ClearContents
                End If
                If c.row + x >= Range("E" & Rows.count).End(xlUp).row Then
                    Exit Do
                End If
                x = x + 1
            Loop
        End If
    Next
End Sub

这将从顶部开始，然后向下寻找每个人的重复项。

或者您可以使用以下内容删除该行：

Sub Testing2()
    Dim x
    For Each c In Range(Range("E1"), Range("E" & Rows.count).End(xlUp))
        If Range("B" & c.row).Value <> "" Then
            x = 1
            Do Until Range("B" & c.row + x).Value <> ""
                If Range("E" & c.row).Value = Range("E" & c.row + x).Value And Range("F" & c.row).Value = Range("F" & c.row + x).Value Then
                    Range("A" & c.row + x).Select
                    ActiveCell.Offset(0, 0).Rows("1:1").EntireRow.Select
                    Selection.Delete shift:=xlUp
                End If
                x = x + 1
            Loop
        End If
    Next
End Sub

Answer 2

@Masoud评论后更新 这匹配所需的输出

Option Explicit
Sub RemoveDuplicates()
    Dim rng As Range, c As Range, rCell As Range
    Dim temp As Range

    ' Update this to reference your sheet
    With Sheet1
        Set rng = .Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1))
    End With

    For Each rCell In rng
        Set c = Nothing
        If rCell.Offset(0, 1) = vbNullString Then
            With rCell.Offset(0, 1)
                Set temp = Range(.End(xlUp), .End(xlDown).Offset(-1, 0)).Offset(0, 3)
            End With
            Set c = temp.Find(rCell.Offset(0, 4), lookat:=xlWhole, after:=rCell.Offset(0, 4))

            If Not c Is Nothing Then
                If rCell.Offset(0, 5) = c.Offset(0, 1) And c.Row <> rCell.Row Then
                    Range(rCell.Offset(0, 4), rCell.Offset(0, 5)).ClearContents
                End If
            End If
        End If
    Next rCell
End Sub

看看下面的内容。这将循环遍历工作表中的所有行，如果列B中的单元格为空，则尝试查找它是否存在于工作表中的其他位置。如果是这样，那么它将清除该行的内容。

我认为您需要更多地定义您认为重复的内容。在你的问题中，你：

离开row3（第6行的副本）
删除row2（除非您忽略客户，否则不重复）

所以你的逻辑中断了。如果您要比较客户（即离开Row3），那么只有row6最终会被删除。但是，如果您不是要比较客户以及部分重复项，那么也应该从期望的结果中删除row3。

Option Explicit
Public Sub RemoveDuplicates()
    Dim rng As Range, c As Range, rCell As Range

    ' Update this to reference your sheet
    With Sheet1
        Set rng = .Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1))
    End With

    For Each rCell In rng
        Set c = Nothing
        If rCell.Offset(0, 1) = vbNullString Then
            Set c = rng.Offset(0, 4).Find(rCell.Offset(0, 4), lookat:=xlWhole, after:=rCell.Offset(0, 4))

            If Not c Is Nothing Then
                '' If not including customer in comparison
                If rCell.Offset(0, 5) = c.Offset(0, 1) And c.Row <> rCell.Row Then
                '' Uncomment below and comment above if comparing customers as well
                'If rCell.Offset(0, 5) = c.Offset(0, 1) And rCell.Offset(0, 1).Value = c.Offset(0, -3).Value And c.Row <> rCell.Row Then

                    Range(rCell.Offset(0, 4), rCell.Offset(0, 5)).ClearContents
                End If
            End If
        End If
    Next rCell
End Sub

Answer 3

如果您不想循环遍历单元格，可以尝试下面的内容......

Sub ClearDuplicateItems()
    Dim lr As Long
    Application.ScreenUpdating = True
    lr = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Columns("G:H").Insert
    Range("G2:G" & lr).Formula = "=INDEX(B$2:B2,MATCH(""zzz"",B$2:B2))"
    Range("H2:H" & lr).Formula = "=IF(COUNTIFS(G$2:G2,INDEX(B$2:B2,MATCH(""zzz"",B$2:B2)),E$2:E2,E2)>1,NA(),"""")"
    On Error Resume Next
    Range("H2:H" & lr).SpecialCells(xlCellTypeFormulas, 16).Offset(0, -2).ClearContents
    Range("H2:H" & lr).SpecialCells(xlCellTypeFormulas, 16).Offset(0, -3).ClearContents
    Columns("G:H").Delete
    Application.ScreenUpdating = True
End Sub

在excel中清除内容的VBA代码

3 个答案: