如何复制/select附有边框的工作表中的单元格范围？

我有一个多张工作簿。 在每张表中我都有几张tables 。 每个table都有用厚边框包围的所需数据。 在每张表中都有多个 tables 。 表格的其余部分根本没有边界 。

我怎样才能通过使用VBA检测每个这样的表的单元格的范围？

Answer 1

假设你的工作表看起来像这样。

逻辑 ：

1. 我们将会find左上angular的单元格，它具有左边框和上边框
2. 接下来，我们将find右下angular的单元格，它具有右侧和底部边框
3. 如果表格格式不正确，或者在错误的位置有LEFT and TOP border和RIGHT and BOTTOM Border LEFT and TOP border ， RIGHT and BOTTOM Border LEFT and TOP border和RIGHT and BOTTOM Border LEFT and TOP border ，逻辑将失败。
4. 这只是一个示范。 如果表中有数据，则将What:=""改为What:="*"

代码 ：我只是展示如何使用.Findsearch第一个表。 要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以便使用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 

产量