循環遍歷單元格範圍，如果某個值在該範圍內超過3次，則更改顏色

Question

我有一列中包含不同的數字。我的代碼正在對它們進行排序，並將檢查相同編號在該列中出現的頻率。如果一個值出現超過3次，則應該爲包含該值的所有行着色，否則應該刪除行。

這裏是我到目前爲止的代碼：

Sub mySub10() 

Dim wsTEMP As Worksheet 
Dim wsSPECIAL As Worksheet 
Dim wsTEMPLrow As Long 
Dim i As Integer 
Dim x As Integer 
Dim rng As Range 

Set wsTEMP = ThisWorkbook.Sheets("Temp") 
Set wsSPECIAL = ThisWorkbook.Sheets("Spezial") 

Application.ScreenUpdating = False 

wsTEMPLrow = Worksheets("Temp").Range("A" & Worksheets("Temp").Rows.Count).End(xlUp).Row 

With wsTEMP 

    .Columns("A:Q").Sort Key1:=.Range("L1"), Order1:=xlAscending, Header:=xlYes, _ 
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ 
    DataOption1:=xlSortNormal 

For i = wsTEMPLrow To 5 Step -1 
    Set rng = Range("A" & i) 
    If Cells(i, 12).Value = Cells(i - 1, 12).Value And Cells(i, 12).Value = Cells(i - 2, 12).Value And Cells(i, 12).Value = Cells(i - 3, 12).Value And Cells(i, 12).Value = Cells(i - 4, 12).Value Then 
      Range("A" & i).EntireRow.Interior.ColorIndex = 6 
      Range("A" & i - 1).EntireRow.Interior.ColorIndex = 6 
    End If 
Next 

For i = wsTEMPLrow To 2 Step -1 
    Set rng = Range("A" & i) 
    If rng.Interior.ColorIndex <> 6 Then 
     rng.EntireRow.Delete 
    End If 
Next   

End With 

End Sub 

Answer 1

下面是做到這一點的方法之一。首先，在另一列中添加COUNTIF公式。這將顯示每個數字出現在列A中多少次。下面是一個小數據集的例子。在B2單元格中的公式爲=COUNTIF($A$2:$A$15,A2)，它的手動複製下來 - 或者你可以在VBA做到這一點：

Range("B2:B15").Formula = "=COUNTIF($A$2:$A$15, $A2)" 

我條件格式應用到A欄以突出其計爲3個或更多的值。

然後你就可以刪除那些行，其中的計數小於3：

Dim r As Range 
Dim i As Long 
Set r = Range("B2:B15") 
For i = r.Rows.Count To 1 Step -1 
    With r.Cells(i, 1) 
     If .Value < 3 Then 
      .EntireRow.Delete 
     End If 
    End With 
Next i 

結果：

Answer 2

高亮顯示部分可以使用conditional formatting和COUNTIF來實現。只有刪除必須通過VBA完成。

我假設帶數字的列是列A。

COUNTIF計數出現

的數量要計算的值的出現次數在A列，只是用這個公式在列的第一行，並填充它的整列：

=COUNTIF(A:A, A1) 

COUNTIF對滿足給定條件（第二個參數）的指定範圍（第一個參數）中的所有值進行計數。 A:A是整列A。將單元格引用指定爲COUNTIF的條件意味着應計算相同值的出現次數。

現在您可以刪除COUNTIF公式的列，因爲它僅用於演示COUNTIF如何工作。這將不再需要。

條件格式

使用上面所寫的公式，有可能有條件地格式細胞具有重複三次以上的值。通過使列引用爲絕對值，可以按照與第一個單元格相同的方式格式化整行。如果需要的話

COUNTIF($A:$A, $A1) > 3 

變化3到任何其他常數：選擇整個表中，具有A1細胞活化，並設定條件格式與由下式定義的條件。例如。使用1將在所有重複值上應用格式。

$之前的一部分地址是絕對尋址。 $A1是與當前格式化的單元格相同行中的列A中的單元格（因爲行號仍然是相對的）。有關單元尋址的更多信息，請參閱About cell and range references @ Excel support page。

從VBA

應用格式使用VBA可以應用的格式是這樣的：

Selection.Cells(1,1).Activate 
Selection.FormatConditions.Add Type:=xlExpression, Operator:=xlGreater, _ 
    Formula1:="COUNTIF($A:$A, $A1) > 3" 
Selection.FormatConditions(1).Interior.ColorIndex = 6 

使用Range("A:A").Select選擇整個第一列，如果沒有做選擇，否則。選擇範圍後，使用Selection.FormatConditions.Delete以刪除先前設置的條件格式。你也可能想改變格式。最後一行將字體顏色設置爲當前調色板中的顏色編號6。在默認調色板中爲黃色，可在MS Graph VB reference page for ColorIndex property上看到。

參見：非格式化的行

的

• programming conditional formatting rules - excel vba @ MSDN forums
• Conditional Formatting using VBA

刪除要刪除未格式化的行，遍歷細胞，讓細胞的顏色使用cell.DisplayFormat.Interior.ColorIndex，如果沒有着色請致電cell.EntireRow.Delete：

Dim i As Long 
For i = Selection.Rows.Count To 1 Step -1 
    With Selection.Cells(i, 1) 
     If .DisplayFormat.Interior.ColorIndex <> 6 Then 
      .EntireRow.Delete 
     End If 
    End With 
Next i 

Answer 3

從我瞭解你想要的，我稍微改變你的代碼：

Sub mySub10() 

    Dim wsTEMP As Worksheet 
    Dim wsSPECIAL As Worksheet 
    Dim wsTEMPLrow As Long 
    Dim i As Integer 
    Dim x As Integer 
    Dim rng As Range 

    Set wsTEMP = ThisWorkbook.Sheets("Temp") 
    Set wsSPECIAL = ThisWorkbook.Sheets("Spezial") 

    Application.ScreenUpdating = False 

    wsTEMPLrow = Worksheets("Temp").Range("A" & Worksheets("Temp").Rows.Count).End(xlUp).Row 

    With wsTEMP 

     .Columns("A:Q").Sort Key1:=.Range("L1"), Order1:=xlAscending, Header:=xlYes, _ 
     OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ 
     DataOption1:=xlSortNormal 

    For i = wsTEMPLrow To 5 Step -1 
     Set rng = Range("A" & i) 
     'this checks the two rows before the present one. If this is true, there are at least three rows with the value. 
     If Cells(i, 12).Value = Cells(i - 1, 12).Value And Cells(i, 12).Value = Cells(i - 2, 12).Value Then 
       'this way the three rows you know have the value will be colored as desired. 
       Range("A" & i).EntireRow.Interior.ColorIndex = 6 
       Range("A" & i - 1).EntireRow.Interior.ColorIndex = 6 
       Range("A" & i - 2).EntireRow.Interior.ColorIndex = 6 
     End If 
    Next 

    For i = wsTEMPLrow To 2 Step -1 
     Set rng = Range("A" & i) 
     If rng.Interior.ColorIndex <> 6 Then 
      rng.EntireRow.Delete 
     End If 
    Next 

    End With 

End Sub