如何复制/选择带边框的工作表中的单元格范围？

Question

我有一张多张工作簿.在每张纸上我都有几张tables.每个table都包含厚边框边框所需的数据.每张表中有多个 tables相似的内容.表格的其余部分根本没有边框.

如何使用VBA检测每个此类表的单元格范围？

Answer 1

假设您的工作表看起来像这样.

逻辑:

1. 我们将找到左上角的单元格,它具有LEFT和TOP边框
2. 接下来,我们将找到右下角的单元格,它具有RIGHT和BOTTOM边框
3. 如果表的格式不正确或逻辑将失败都LEFT and TOP border和RIGHT and BOTTOM Border在错误的地方.
4. 这只是一个示范.如果表有数据,则更What:=""改为What:="*"

代码:我只是在演示如何使用搜索第一个表.Find.要查找其余表,您必须.Find在循环中使用

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim TopLeftCell As Range, bottomRightCell As Range

    Set ws = ThisWorkbook.Sheets("Sheet1")

    Application.FindFormat.Clear
    With Application.FindFormat.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With

    With Application.FindFormat.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With

    Set TopLeftCell = ws.Cells.Find(What:="", LookIn:=xlValues, LookAt:= _
    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
    , SearchFormat:=True)

    If TopLeftCell Is Nothing Then Exit Sub

    With Application.FindFormat.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Application.FindFormat.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Application.FindFormat.Borders(xlEdgeLeft)
        .LineStyle = xlNone
    End With
    With Application.FindFormat.Borders(xlEdgeTop)
        .LineStyle = xlNone
    End With

    Set bottomRightCell = ws.Cells.Find(What:="", LookIn:=xlValues, LookAt:= _
    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
    , SearchFormat:=True)

    If bottomRightCell Is Nothing Then Exit Sub

    Debug.Print "The Table Range is " & ws.Range(TopLeftCell.Address, bottomRightCell.Address).Address
End Sub

OUTPUT

注意:

我做了这个练习,因为我发现它很刺激,但在现实生活中,我永远不会使用这种方法.我会这样使用,Named Ranges以便更容易使用范围.

编辑

跟进评论.

要查找所有表,请使用此代码

Option Explicit

Dim ws As Worksheet
Dim aCell As Range
Dim bCell As String

Sub Sample()
    Dim fCell As String, lCell As String

    '~~> Change this to the relevant worksheet
    Set ws = ThisWorkbook.Sheets("Sheet4")

    Set aCell = ws.Cells(1, 1)

    fCell = FindTopLeftCell
    If fCell = "" Then Exit Sub

    lCell = FindBottomRightCell
    If lCell = "" Then Exit Sub

    bCell = fCell

    Debug.Print "The Table Range is " & ws.Range(fCell, lCell).Address

    Do
        fCell = FindTopLeftCell
        If fCell = "" Then Exit Sub

        If fCell = bCell Then Exit Sub

        lCell = FindBottomRightCell
        If lCell = "" Then Exit Sub

        Debug.Print "The Table Range is " & ws.Range(fCell, lCell).Address
    Loop
End Sub

'~~> Funciton to find the top left cell
Function FindTopLeftCell() As String
    Dim TopLeftCell As Range

    FindTopLeftCell = ""

    Application.FindFormat.Clear
    With Application.FindFormat.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With

    With Application.FindFormat.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With

    Set TopLeftCell = ws.Cells.Find(What:="*", After:=aCell, LookIn:=xlValues, LookAt:= _
    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
    , SearchFormat:=True)

    If Not TopLeftCell Is Nothing Then FindTopLeftCell = TopLeftCell.Address
End Function

'~~> Funciton to find the bottom right cell
Function FindBottomRightCell() As String
    Dim bottomRightCell As Range

    FindBottomRightCell = ""

    Application.FindFormat.Clear
    With Application.FindFormat.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Application.FindFormat.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Application.FindFormat.Borders(xlEdgeLeft)
        .LineStyle = xlNone
    End With
    With Application.FindFormat.Borders(xlEdgeTop)
        .LineStyle = xlNone
    End With

    Set bottomRightCell = ws.Cells.Find(What:="*", After:=aCell, LookIn:=xlValues, LookAt:= _
    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
    , SearchFormat:=True)

    If Not bottomRightCell Is Nothing Then FindBottomRightCell = bottomRightCell.Address

    Set aCell = bottomRightCell
End Function

产量