VBA代码清除excel中的内容
如果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
看来你想要的是清除range(E:F) ，其中B是空白， 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
@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（row6的重复）
- 删除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
如果你不想循环的单元格，你可以尝试下面的东西…
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