如何为高亮筛选行交替地写macros

如何在Excel中编写此结构的macros要突出显示筛选的行或者..在此先感谢

Answer 1

如果你的数字被分成总是不同的数字重复块，那么你可以使用这个VBA代码：

Sub main() Dim item As Variant Dim startRow As Long Dim okHighlight As Boolean With Range("A1", Cells(Rows.count, 1).End(xlUp)) For Each item In GetUniqueValues(.Cells).Items If okHighlight Then .Range(.Cells(startRow, 1), .Cells(item, 1)).Interior.ColorIndex = 48 startRow = item + 1 okHighlight = Not okHighlight Next End With End Sub Function GetUniqueValues(rng As Range) As Dictionary Dim cell As Range Dim dict As Dictionary Set dict = New Dictionary With dict For Each cell In rng .item(cell.Value) = cell.row - rng.Rows(1).row + 1 Next End With Set GetUniqueValues = dict End Function 

---

有条件的格式化方法可以使用助手列

假设：

• 您的数据在第2行开始的A列中

• B列是免费的

然后：

• 将以下公式写入辅助列B单元格中：

  = IF（A2 <> A1，B1 + 1,0）

• 使用以下公式将条件格式应用于列A：

  = INT（B2 / 2）= B2 / 2

并select你喜欢的格式来突出显示单元格

Answer 2

在这里你是朋友，用你的工作表名称replaceSheet4 。

 Option Explicit Sub Test() Dim rngOrigin As Excel.Range Set rngOrigin = Sheet4.Cells(1, 1) Dim rng As Excel.Range Set rng = Sheet4.Range(rngOrigin, rngOrigin.End(xlDown)) Dim bToggle As Boolean Dim rngLoop As Excel.Range For Each rngLoop In rng If rngLoop.Row > 1 Then If rngLoop.Offset(-1, 0).Value <> rngLoop.Value Then bToggle = Not bToggle End If End If rngLoop.Interior.ColorIndex = VBA.IIf(bToggle, 4, 2) Next End Sub 

Answer 3

在许多方面做到这一点，这里有另一个：

 Option Explicit Sub colorAltRowGroups() With Sheets(1) Dim colorCell As Boolean: colorCell = False Dim val As String, prvVal As String prvVal = .Cells(1, 1).Value Dim c As Range For Each c In Range("A1", .Cells(Rows.Count, 1).End(xlUp)): val = c.Value If (val <> prvVal) Then colorCell = Not colorCell If colorCell Then c.Interior.Color = vbYellow prvVal = val Next End With End Sub 

编辑：

如果您想为整行着色，您可以用以下代码replace上面代码中的If colorCell语句：

 If colorCell Then c.EntireRow.Interior.Color = vbYellow