vba 如果值在该范围内超过 3 次，则遍历单元格范围并更改颜色

Loop through range of cells and change color if a value is in that range more then 3 times

提问by DEFCON123

I have one column with different numbers in it. My code is sorting them and shall check how often the same number appears in that column. If one value appears more than 3 times, it should color all rows containing that value, else the rows should be deleted.

我有一列有不同的数字。我的代码正在对它们进行排序，并将检查该列中出现相同数字的频率。如果一个值出现 3 次以上，它应该为包含该值的所有行着色，否则应删除这些行。

Here is my code so far:

到目前为止，这是我的代码：

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

采纳答案by Jean-Fran?ois Corbett

Here's one way to do it. First, add a COUNTIFformula in another column. This will reveal how many times each number appears in column A. Here's an example of this with a small dataset. The formula in cell B2 is =COUNTIF($A$2:$A$15,A2)and it's copied down manually -- or you can do this in VBA:

这是一种方法。首先，COUNTIF在另一列中添加一个公式。这将显示每个数字在 A 列中出现的次数。这是一个小数据集的示例。单元格 B2 中的公式是=COUNTIF($A$2:$A$15,A2)手动复制的 - 或者您可以在 VBA 中执行此操作：

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

I applied conditional formatting to column A to highlight those values whose count is 3 or more.

我对 A 列应用了条件格式以突出显示那些计数为 3 或更多的值。

Then you can delete those rows where the count is less than 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

Result:

结果：

回答by Palec

The highlighting part can be achieved using conditional formattingand COUNTIF. Only deletion has to be done through VBA.

突出显示部分可以使用条件格式和COUNTIF. 只能通过 VBA 进行删除。

I assume the column with numbers is column A.

我假设带有数字的列是 column A。

COUNTIFcounts number of occurrences

COUNTIF计数出现次数

To count number of occurrences of a value in column A, just use this formula in first row of a column and fill the whole column with it:

要计算 column 中某个值的出现次数A，只需在列的第一行使用此公式并用它填充整列：

=COUNTIF(A:A, A1)

COUNTIFcounts all values in the specified range (first argument) that satisfy the condition given (second argument). A:Ais the whole column A. Specifying cell reference as a condition to COUNTIFmeans that occurrences of the same value should be counted.

COUNTIF计算指定范围（第一个参数）中满足给定条件（第二个参数）的所有值。A:A是整列A。将单元格引用指定为条件COUNTIF意味着应计算相同值的出现次数。

Now you can delete the column with COUNTIFformula as it was used just for demonstration of how COUNTIFworks. It will not be needed anymore.

现在您可以删除带有COUNTIF公式的列，因为它仅用于演示COUNTIF工作原理。将不再需要它。

Conditional formatting

条件格式

Using the formula written above, it is possible to conditionally format cells with values repeating more than three times. By making the column references absolute, it is possible to format whole lines the same way as their first cell. Select the whole table, having the A1cell activated, and set conditional formatting with condition defined by the following formula:

使用上面编写的公式，可以有条件地格式化具有重复次数超过 3 次的值的单元格。通过将列引用设为绝对引用，可以按照与第一个单元格相同的方式设置整行的格式。选择整个表格，A1激活单元格，并使用以下公式定义的条件设置条件格式：

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

Change 3 to any other constant if needed. E.g. using 1 applies the format on all duplicate values.

如果需要，将 3 更改为任何其他常量。例如，使用 1 将格式应用于所有重复值。

$before a part of an address is absolute addressing. $A1is the cell in column Ain the same row as currently formatted cell (as the row number is still relative). For more info on cell addressing see About cell and range references @ Excel support page.

$在地址的一部分之前是绝对寻址。$A1是与A当前格式化的单元格在同一行的列中的单元格（因为行号仍然是相对的）。有关单元格寻址的详细信息，请参阅关于单元格和范围引用@Excel 支持页面。

Applying the format from VBA

从 VBA 应用格式

Using VBA you can apply the formatting like this:

使用 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

Use Range("A:A").Selectto select the whole first column if not having done the selection otherwise. Use Selection.FormatConditions.Deleteafter selecting the range to get rid of the conditional formatting set previously. You may want to alter the format, too. The last line just sets the font color to color number 6 in the current palette. It is yellow in the default palette, which can be seen on MS Graph VB reference page for ColorIndex property.

使用Range("A:A").Select选择整个第一列，如果没有做选择，否则。Selection.FormatConditions.Delete选择范围后使用以摆脱先前设置的条件格式。您可能还想更改格式。最后一行只是将字体颜色设置为当前调色板中的颜色编号 6。它在默认调色板中为黄色，可以在MS Graph VB 参考页面上查看 ColorIndex 属性。

See:

看：

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

• 编程条件格式规则 - excel vba @ MSDN 论坛
• 使用 VBA 进行条件格式

Deletion of non-formatted rows

删除非格式化行

To delete the rows that are not formatted, loop through the cells, get cell's color using cell.DisplayFormat.Interior.ColorIndexand call cell.EntireRow.Deleteif it is not colored:

要删除未格式化的行，请遍历单元格，使用获取单元格的颜色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

回答by brWHigino

From what I understood you want, I slightly changed your code:

根据我对您的理解，我稍微更改了您的代码：

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