宏：绘制边界线以在同一日期内对数据进行分组

Question

实际上我是使用宏的新手，我在绘制边界线时遇到了一些困难，以便将相同日期的所有数据分组。我的代码如下所示，感谢有人能帮我解决这个问题。结果应如图所示显示。

=============================================== =========================================

Public i As Integer

Sub GetCellValue()

Dim rngEnd As Range
NumRows = Range("A3", Range("A3").End(xlDown)).Rows.Count
Range("A3").Select

For i = 3 To NumRows

If Cells(i, 1).Value <> Cells(i + 1, 1).Value Then
   Call BorderCode
   Cells(i + 1, 1).Select
End If

Next

End Sub


Sub BorderCode()

Range(Cells(3, 1), Cells(i, 11)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

End Sub

Answer 1

如果日期在A列中，并且所有日期已经排序，您可以使用Do...Loop来完成A列中的所有单元格，并相应地进行分组。

另外，我建议使用Range.BorderAround方法。这样更清晰，更快，并且避免了使用Selection（请参阅here）。

所以，这里有一个关于如何做到这一点的想法。

Dim r1 As Byte, r2 As Byte
Dim lr As Long
'prime the loop
r1 = 1 'first row pointer
r2 = r1 'look-ahead row pointer
lr = Range("A1").End(xlDown).Row + 1 'the first row with
'a blank line, so the loop knows when to stop.

'loop only in the data, stop when a blank line encountered
Do While r1 < lr
  'figure out how many days are together
  Do While Cells(r2 + 1, 1).Value = Cells(r1, 1).Value
    r2 = r2 + 1
  Loop
  'draw border around similiar ranges
  Range(Cells(r1, 1), Cells(r2, 1)).BorderAround _
    ColorIndex:=xlColorIndexAutomatic
  'prime for the next Do...Loop iteration
  r1 = r2 + 1
  r2 = r1
Loop