我希望在有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
我想突出显示3个或更多活动订单状态的所有地址。
答案 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