Excel只删除唯一的单元格

我一直在努力想出一个解决方案来删除所有在我的Excel表单中唯一的单元格。Excel只删除唯一的单元格

我有一个看起来像这样一个Excel工作表：

cat dog shrimp donkey 
dog human wale  
wale bear 

dog donkey shrimp human wale

，我想现在删除的所有细胞之间唯一的所有值（所以这里将被删除猫和熊），同时保持所有行的所有顺序等完好无损。我也有几行是完全空的（但我不能删除）。

我试过下面的宏，但它是我的第一个vba宏（我知道它愚蠢低效:)）由于某种原因，它不会删除任何东西，但我看不到逻辑错误。

代码：

Sub doit() 
Dim rng As Range 
Dim rngtoCheck As Range 
Dim cell As Range 
Dim isCellUnique As Boolean 
Dim cellToCheck As Range 

Set rng = Range("A1:Z20") 
Set rngtoCheck = Range("A1:Z20") 

For Each cell In rng 
    isCellUnique = True 

    For Each cellToCheck In rngtoCheck 

     If cell.Value = cellToCheck.Value AND cell.row <> cellToCheck.row Then 
      isCellUnique = False 
     End If 

    Next cellToCheck 

    If isCellUnique = True Then 
     cell.ClearContents 
    End If 

Next cell 


End Sub

的想法是，在整个范围和我检查范围内的任何其他细胞具有相同的值，而不是在同一行的每个单元格我循环。如果两者都检查出来，我保留这个值，否则我清除细胞。

我在做什么错？

来源

2014-09-04 Grinner

你得到什么错误？我只是用相同的数据运行它，它运行得很好（猫/熊删除）。 – mrbungle 2014-09-04 16:46:23

我只是试了一遍，现在它也适用于我。我不知道为什么它第一次不会在Excel表格上做任何事情。很奇怪。对不起，麻烦... – Grinner 2014-09-04 17:15:16

您可以使用Application.WorksheetFunction.CountIf来检查单元格是否重复多次？

这是你正在尝试？

久经考验

Sub doit() 
    Dim rng As Range, aCell As Range 

    '~~> Change this to the relevant sheet 
    Set rng = ThisWorkbook.Sheets("Sheet1").Range("A1:Z20") 

    For Each aCell In rng 
     If Not Len(Trim(aCell.Value)) = 0 Then 
      '~~> Check if word occurs just once 
      If Application.WorksheetFunction.CountIf(rng, aCell.Value) = 1 Then 
       MsgBox aCell.Value & " is unique" 
       ' 
       '~~> Do what you want here 
       ' 
      End If 
     End If 
    Next aCell 
End Sub

来源

2014-09-04 17:03:19

是的，其实是。它运作良好，谢谢！ – Grinner 2014-09-04 17:14:23

Excel只删除唯一的单元格

回答

相关问题