Question

我有一个excel文件，原始数据分为范围，修复的是数据有6列，数据从标题下面的2行开始。

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

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

我的任务是为每个范围添加边框，但只添加数据部分，我收到Loop的错误而没有Do.

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

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

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

解决问题的最佳方法是将其分解为单个可测试组件。

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的宁静祷告：

Lord授予我VBA技能，使我无法轻易改变的事物自动化;充分利用内置功能的知识;以及了解差异的智慧。

将边框添加到动态范围vba

3 个答案: