添加边界到dynamic范围vba

我有一个原始数据分解成范围的excel文件，固定的是数据有6列，数据从头下面的2行开始。

我每周都会得到新的数据，因此每个范围（或数据块​​）都有不同的大小，这意味着上次使用的行和最后使用的列将会有所不同。 我已经发布了一个样本数据，所以你有一个想法，我只发布了3个范围，所以它适合在图片很好， 和期望的结果。

这是我写的较大代码的一部分，所以我希望通过编写vba代码来实现这一点。

我的任务是添加边界到每个范围，但只有数据部分，我得到循环没有做的错误。

Sub test() Dim d, e As Long Dim c As Range With Sheet1.Rows(3) Set c = .Find("Status", LookIn:=xlValues) If Not c Is Nothing Then firstAddress = c.Address With c d = Cells.SpecialCells(xlCellTypeLastCell).Row e = c.row End With Do With c.Offset(d-e+2, 6) With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With .Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With .Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address <> firstAddress End With End If End With End Sub 

Answer 1

我采取了与你相同的方法，但做了一些修改，以减less代码行。 希望它能满足你的需求。 让我知道

 Sub BorderData() Dim c As Range Dim firstaddress As String Dim ws1 As Worksheet Set ws1 = Sheets("Sheet1") With ws1.Rows(3) Set c = .Find("Status", LookIn:=xlValues) If Not c Is Nothing Then firstaddress = c.Address Do ws1.Range(c.Offset(2), c.End(xlDown).End(xlToRight)).BorderAround LineStyle:=xlContinuous, Weight:=xlThick Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address <> firstaddress End If End With End Sub 

Answer 2

解决问题的最好方法是将其分解成单个可testing的组件。

 Sub NewTest() Dim cell As Range, list As Object Set list = getFindCells(Sheet1.Rows(3)) For Each cell In list FormatRange Intersect(cell.CurrentRegion.Offset(2), cell.CurrentRegion) Next End Sub Sub FormatRange(Target As Range) With Target With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With .Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With .Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With End With End Sub ' https://msdn.microsoft.com/en-us/vba/excel-vba/articles/range-find-method-excel Function getFindCells(Target As Range) As Object Dim c As Range, list As Object Dim firstAddress As String Set list = CreateObject("System.Collections.ArrayList") With Target Set c = .Find(2, LookIn:=xlValues) If Not c Is Nothing Then firstAddress = c.Address Do list.Add c Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address <> firstAddress End If End With Set getFindCells = list End Function 

Answer 3

将您的范围转换为Excel表（也称为ListObjects）并使用它们提供的内置格式。 表格样式可以改变，以显示任何你想要的，只是一个简单的边界。

如有疑问，请参考VBA的宁静祈祷：

主给我的VBA技能，使我不能轻易改变的事情自动化; 充分利用我可以利用的内在function的知识; 以及了解差异的智慧。