使用 vba 查找 table 范围的地址

Question

我正在使用一个 excel sheet，它有一堆 sheet，数据在 table 中。我正在尝试合并 sheets。我不希望复制的数据在 tables 中。我能够找到所有 sheets 的 tables 范围地址，除了一个，它正在返回 $1:$104 的地址。所有其他范围都是这样的 "$A$1:$J$43" 。当我尝试使用地址 returns 复制此 table 时，出现运行时错误“1004”。现在，代码在同一位置重写了所有 table，但我将更改代码以将 table 复制到目标 sheet 的不同位置。这是我的代码：

  Sub mergeWorksheets()
   Dim wrk As Workbook 'Workbook object - Always good to work with 
 object variables
   Dim sht As Worksheet 'Object for handling worksheets in loop
   Dim trg As Worksheet 'Master Worksheet
   Dim rng As Range 'Range object
   Dim colCount As Integer 'Column count in tables in the worksheets
   Dim mLastRow As Integer
   Dim LastRow As Integer
   Dim rngFound As Range
   Dim i As Integer

Set wrk = ActiveWorkbook 'Working in active workbook

'We don't want screen updating
Application.ScreenUpdating = False

' would rather not do a loop but using a function to check and delete sheet renders error
For Each Sheet In ActiveWorkbook.Worksheets
 If Sheet.Name = "Master" Then
    Application.DisplayAlerts = False
    Sheets("Master").Delete
    Application.DisplayAlerts = True
 End If
Next Sheet
 ' Add new worksheet as the last worksheet
  Set trg = wrk.Worksheets.Add(Before:=wrk.Worksheets(1))
 ' Rename the new worksheet
  trg.Name = "Master"

 'We can start loop
 For Each sht In wrk.Worksheets
    'If worksheet in loop is the last one, stop execution (it is Master worksheet)
    If sht.Name Like "*Attri*" Then
           Debug.Print sht.Name
           'Find the last row of the master sheet
           Set rngFound = trg.UsedRange.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious)
           If Not rngFound Is Nothing Then
           'you found the value - do something
               mLastRow = rngFound.Row
               Debug.Print "Last row of master " & rngFound.Address, mLastRow
           Else
           ' you didn't find anything becasue sheet is empty - first pass
              mLastRow = 0
           End If
           For Each tbl In sht.ListObjects
               'Do something to all the tables...
                Debug.Print tbl.Name
                Debug.Print tbl.Range.Address
                'Put data into the Master worksheet
                    tbl.Range.Copy Destination:=trg.Range("B1")
                 Next tbl

       '    trg.Cells(mLastRow + 1, 1).Value = "Tab Name"
        '   trg.Cells(mLastRow + 1, 1).Font.Bold = "True"
         '  trg.Range("A" & mLastRow + 1).Value = sht.Name

        Debug.Print "-------"
        Else
           ' Debug.Print "error " & sht.Name & " is missing header "
        End If

Next sht

Answer 1

那个有趣的范围显然就在那里。您可以做的是控制要复制的数据的大小。如果您可以为 table 宽度设置一个有意义的最大值，那么您可以像这样限制大小：

const MAXWID = 1000
Dim r As Range

If tbl.Range.Columns.Count > MAXWID Then
    Set r = tbl.Range.Resize(, MAXWID)
Else
    Set r = tbl.Range
End If

r.Copy Destination:=trg.Range("B1")

有趣的事情也可能发生在 table(s) 的高度上，因此您可能希望对其他维度实施此操作。要附加 tables，您需要知道第一个空行的位置：

FirstEmptyRow = trg.Range("B1").SpecialCells(xlCellTypeLastCell).Row + 1
r.Copy Destination:=trg.Cells(FirstEmptyRow, "B")

对于 sheet 操作，您需要像这样使用 On Error ...：

Application.DisplayAlerts = False
On Error Resume Next
Set trg = wrk.Sheets("Master")
If Err.Number = 0 Then    ' sheet exists
    trg.Usedrange.Delete  ' delete all existing data -> have a clean sheet
Else   ' sheet doesn't exist, Add new worksheet as the first worksheet
    Set trg = wrk.Worksheets.Add(Before:=wrk.Worksheets(1))
    If Err.Number <> 0 Then <  sheet is not added, handle error...>
    trg.Name = "Master"
End If
On Error Goto 0
Application.DisplayAlerts = True

值得花时间了解 VBA 中错误处理的工作原理。

最后：使用 Option Explicit。它支付。

使用 vba 查找 table 范围的地址

Finding the address of a table range using vba

vba

excel-2013