Excel只删除唯一单元格

Question

我一直在努力想出一个解决方案，删除excel工作表中唯一的所有单元格。

我有一张excel表，看起来像这样：

cat    dog    shrimp    donkey
dog    human  wale      
wale   bear
dog    donkey shrimp    human    wale

我现在想删除所有单元格中唯一的所有值（所以这里将删除cat和bear），同时保持所有行等的所有顺序不变。我还有一些行是完全空的（但我无法删除）。

我尝试过以下宏，但这是我的第一个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

其想法是，我循环遍历整个范围，并为每个单元格检查该范围中是否有其他单元格具有相同的值，但不在同一行上。如果两者都签出，我会保留值，否则我会清除单元格。

我做错了什么？

Answer 1

您可以使用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