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只刪除唯一的單元格

回答

相關問題