循环过滤范围excel vba

时间:2017-03-29 16:14:33

标签: excel vba

我希望在有3个或更多具有相同值的单元格时突出显示单元格,我有波纹管代码,但它无法正常工作,因为它在每个范围内循环两次。有人能告诉我出了什么问题吗?

Sub HighlightCells()
Dim k As Integer, myCounter As Integer, firstRow As Integer
Dim myClientExport As Worksheet, myTemplate As Variant
Dim vRange As Range, myRange As Range 
Dim myAddr As String

Set myClientExport = Excel.ActiveSheet 
Set vRange = myClientExport.UsedRange.SpecialCells(xlCellTypeVisible) 


firstRow = vRange.Areas(2).Rows(1).Row
myAddr = Cells(firstRow, 4).Value
myCounter = 0
For Each myRange In vRange.Rows 
    k = myRange.Row

    If k > firstRow Then
        If myAddr = Cells(k, 4).Value Then
            myCounter = myCounter + 1
        Else
            myAddr = Cells(k, 4).Value
            myCounter = 0
        End If
        Select Case myCounter
            Case 3

                For i = 0 To 2
                    OId = Cells(k - i, 1).Value
                 Next i
                Cells(k, 4).Interior.ColorIndex = 27
                Cells(k - 1, 4).Interior.ColorIndex = 27
                Cells(k - 2, 4).Interior.ColorIndex = 27
            Case Is > 3
                Cells(k, 4).Interior.ColorIndex = 27
        End Select
    End If
Next myRange
End Sub

My data unfiltered look like:

My data filtered look like

我想突出显示3个或更多活动订单状态的所有地址。

2 个答案:

答案 0 :(得分:0)

我无法让您的代码正常运行。我得到了#34;应用程序定义或对象定义" firstRow = vRange.Areas(2).Rows(1).Row上的运行时错误。

所以我做的是E列中的CountIf公式: =COUNTIF(D$2:D$7,D2)然后设置条件格式。如果范围是动态的,请使用VBA确定限制并传播公式和条件格式。类似的东西:

Dim rCount As Integer
rCount = Range("D1", Range("D2").End(xlDown)).Rows.Count
Range("D2:D" & rCount).Select
Selection.Cells.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$E2=3"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
    .PatternColorIndex = xlAutomatic
    .Color = 65535
    .TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Range("E2:E" & rCount).Select
Selection.Formula = "=CountIf($D$2:$D$" & rCount & ", $D2)"

答案 1 :(得分:0)

你可以尝试这样的东西来看看它是否适合你。 代码将在F列中放置一个CountIFs公式,并在最后删除它。 您可以根据自己的要求调整代码。

Sub HighlightFilteredCells()
Dim sws As Worksheet
Dim lr As Long
Dim cell As Range
Set sws = Sheets("Sheet1")
If sws.FilterMode Then sws.ShowAllData
lr = Cells(Rows.Count, 1).End(xlUp).Row
sws.Range("F2:F" & lr).Formula = "=COUNTIFS($D$2:$D$" & lr & ",D2,$E$2:$E$" & lr & ",""Active"")"
sws.Columns(5).Interior.ColorIndex = xlNone
With sws.Rows(1)
    .AutoFilter field:=5, Criteria1:="Active"
    If sws.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Rows.Count > 1 Then
        For Each cell In sws.Range("F2:F" & lr).SpecialCells(xlCellTypeVisible)
            If cell.Value >= 3 Then cell.Offset(0, -1).Interior.Color = vbYellow
        Next cell
    End If
End With
sws.Columns(6).Clear
End Sub