请尝试下一种方式：

Sub BorderArroudAreas()
   Dim sh As Worksheet, lastR As Long, rng As Range, rngBord As Range, arrBord, El, A As Range
   
   Set sh = ActiveSheet
   lastR = sh.Range("B" & sh.rows.count).End(xlUp).row 'last row on B:B
   
   Set rng = sh.Range("B1:B" & lastR).SpecialCells(xlCellTypeConstants) 'the B:B discontinuous range (empty rows is a delimiter for the range areas)
   
   'obtain a range having the same areas in terms of rows, but all used range columns:
   Set rngBord = Intersect(rng.EntireRow, sh.UsedRange.EntireColumn)
   
   'create an array with numbers from 7 to 12 (the borders type constants...)
   arrBord = Application.Evaluate("Row(7:12)") 'used to place cells borders
   
   For Each A In rngBord.Areas 'iterate between the range areas
        For Each El In arrBord 'place borders on each area cells:
             With A.Borders(El)
                   .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = 0
             End With
         Next El
   Next A
End Sub

它应该更快，即使是大范围，而不是放置边界为每个单元格.

你的代码可以工作，但是你没有从循环中排除空行，这意味着你的UsedRange中的所有单元格都有边框。你应该添加一个检查空行的功能，并从边框中排除那些空行。

Dim border As Range
Dim brng As Range

Set border = ThisWorkbook.ActiveSheet.UsedRange

For Each brng In border
    If WorksheetFunction.CountA(brng.EntireRow) > 0 Then
        brng.BorderAround _
            LineStyle:=xlContinuous, _
            Weight:=xlThin
    End If
Next brng

我看到你的代码中已经有了一个End If，不知道你从哪里开始你的If。

BorderAround只是在指定的范围内放置一个边框。
如果原始数据根本没有边界，并且您希望得到的结果与图像的右侧相同，则需要应用水平，垂直等。

Sub test()
For Each brng In ActiveSheet.Columns(2).SpecialCells(xlConstants).Areas
With brng.Offset(0, -1).Resize(brng.Rows.Count, 5)
    .select '---> use to check when in debug mode if the range is correct, remove this line later on
    .BorderAround LineStyle:=xlContinuous, Weight:=xlThin
    With .Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With .Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
End With
Next
End Sub