日期、列、条件格式、相邻单元格（下方/上方）

Question

大家好，

我确实相信我的问题需要 VBA 代码。 所以，请善待并帮助我。

我有很多日期的表格（所有日期都在一个特定的列中）。 带有日期的单元格无需特殊顺序即可填充。 由于其他数据（其他列中的数据），过滤不适用。

需要什么（问题）：

• 有没有办法比较相邻单元格的日期（单元格上方/下方），

• 如果日期相同，则从具有相同日期的列中的 1 个单元格中复制条件格式，

• 仅当相邻日期不同时，条件格式才会更改，

例如：

Column (date)   I conditional formatting interior cell color

A           I   (CF)

25.11.2017  I   blue

26.11.2017  I   red

26.11.2017  I   red

26.11.2017  I   red

22.11.2017  I   blue

22.11.2017  I   blue

25.11.2017  I   red

etc.        I   etc.

我熟悉 VBA，所以 VBA 代码会很棒。我相信，这里需要 Private Sub。

非常感谢。

来自克罗地亚的问候

马尔科

Answer 1

假设数据从单元格 A1 开始。我认为这可能可以简化一点。

然而，

Public Sub ColourCells()

   Dim wb As Workbook
   Dim wsSource As Worksheet

   Set wb = ThisWorkbook
   Set wsSource = wb.Worksheets("Sheet1")

   Dim lastRow As Long

   lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row

   Dim loopRange As Range

   Set loopRange = wsSource.Range("A1:A" & lastRow) ' adjust here if starts elsewhere

   Dim currValue As Variant
   Dim cellColor As String

   cellColor = vbBlue

   Dim currCell As Range

   For Each currCell In loopRange.Rows

       If Not IsEmpty(currCell) Then

           If currCell.Row = 1 Then 
                currCell.Font.Color = cellColor
                currValue = currCell.Value2

           ElseIf currCell = currValue Then
                currCell.Font.Color = cellColor

           Else
                If cellColor = vbBlue Then
                    cellColor = vbRed
                Else  
                    cellColor = vbBlue
                End If

                currCell.Font.Color = cellColor
                currValue = currCell.Value2

          End If

       End If

   Next currCell

End sub