Question

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

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

cat    dog    shrimp    donkey
dog    human  wale      
wale   bear

dog    donkey shrimp    human    wale

我想现在删除所有单元格中唯一的值（所以这里将删除cat and 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

Excel仅删除唯一的单元格

1 个答案: