循环遍历单元格范围，如果值在该范围内超过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

使用conditional formatting和COUNTIF可以实现突出显示部分。只有通过VBA才能删除。

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

COUNTIF计算出现次数

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

=COUNTIF(A:A, A1)

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

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

条件格式

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

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

如果需要，将3更改为任何其他常量。例如。使用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 2

这是一种方法。首先，在另一列中添加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 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