遍历工作表并创建表

时间:2019-03-22 13:22:07

标签: excel vba

我有10个工作表。

我想为每个表创建一个表。每个表都有不同数量的数据,我一直在为每个表使用以下代码,但是我想知道如何使用循环来完成它。

我真的很感谢您的帮助:)

RewriteCond %{QUERY_STRING} ^p=([0-9]*)$
RewriteRule ^ http://www.test.com/?p=%1&preview=true [R=301,L]

尝试了以下方法,但是没有运气

Sub table()
    Dim sht As Worksheet
    Dim lastrow As Long
    Dim LastColumn As Long
    Dim StartCell As Range

    Set sht = Worksheets("m9")
    Set StartCell = Range("A1")

    lastrow = sht.Cells(sht.Rows.Count, StartCell.Column).End(xlUp).Row
    LastColumn = sht.Cells(StartCell.Row, sht.Columns.Count).End(xlToLeft).Column

    sht.Range(StartCell, sht.Cells(lastrow, LastColumn)).Select

    Dim objTable As ListObject
    Set objTable = ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes)
End Sub

2 个答案:

答案 0 :(得分:1)

您应避免使用ActivateSelect语句。以下内容将循环浏览工作簿中的所有工作表,并向每个工作表中添加一个ListObject。它还将进行测试以查看是否已经存在ListObject。如果现有的ListObject与您要将表添加到的范围重叠,它将在重新创建ListObject

之前将其转换为范围
Sub loop_test()
    Dim ws As Worksheet
    Dim StartCell As Range, TblRng As Range
    Dim LastRow As Long, LastColumn As Long
    Dim objTable As ListObject

    For Each ws In ThisWorkbook.Sheets
        Set objTable = Nothing
        With ws
            Set StartCell = .Range("A1")
            LastRow = .Cells(.Rows.Count, StartCell.Column).End(xlUp).Row
            LastColumn = .Cells(StartCell.Row, .Columns.Count).End(xlToLeft).Column


            Set TblRng = .Range(StartCell, .Cells(LastRow, LastColumn))
            ' Test if table exists on sheet
            On Error Resume Next
            Set objTable = .ListObjects(1)
            On Error GoTo 0
            ' If table overlaps with TblRng - Convert to Range
            If Not Intersect(objTable.Range, TblRng) Is Nothing Then
                objTable.Unlist
            End If
            ' Create Table
            Set objTable = .ListObjects.Add(xlSrcRange, TblRng, , xlYes)
        End With
    Next ws
End Sub

答案 1 :(得分:0)

尝试一下。正如扎克所说,请避免激活和选择,并包括图纸参考。

status