VBA Excel-遍歷工作表創建表

Question

創建了此宏以遍歷整個工作表，並將每個部分格式化為具有特定格式的表。

我試圖遍歷整個工作表，並將每個部分格式化為表格。

每個部分由一個空白行分隔。

有任何想法嗎？

Sub Macro8()
Range("A3:B4").Select
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$3:$B$4"), , xlYes).Name = _
    "Table6"
Range("Table6[#All]").Select
ActiveSheet.ListObjects("Table6").TableStyle = "TableStyleLight9"

Selection.End(xlDown).Select
Selection.End(xlDown).Select
Range("A6:B7").Select
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$6:$B$7"), , xlYes).Name = _
    "Table7"
Range("Table7[#All]").Select
ActiveSheet.ListObjects("Table7").TableStyle = "TableStyleLight9"

Selection.End(xlDown).Select
Selection.End(xlDown).Select
Range("A9:D22").Select
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$9:$D$22"), , xlYes).Name = _
    "Table8"
Range("Table8[#All]").Select
ActiveSheet.ListObjects("Table8").TableStyle = "TableStyleLight9"

Selection.End(xlDown).Select
Selection.End(xlDown).Select
Range("A24:D37").Select
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$24:$D$37"), , xlYes).Name = _
    "Table9"
Range("Table9[#All]").Select
ActiveSheet.ListObjects("Table9").TableStyle = "TableStyleLight9"

End Sub

Answer 1

試一下：

Sub MakeTables()

Dim ws As Worksheet
Set ws = Worksheets("Sheet1") 'change as needed

With ws

    'find last row of data in column A
    Dim lRow As Long
    lRow = .Range("A" & .Rows.Count).End(xlUp).Row

    Dim rngStart As Range
    Set rngStart = .Range("A3")

    'set counter variable for naming tables
    Dim i As Long
    i = i + 1

    Do

        'create table range
        Set rngTable = .Range(rngStart, rngStart.End(xlDown))

        'create table
        .ListObjects.Add(xlSrcRange, rngTable.Resize(rngTable.Rows.Count, rngStart.End(xlToRight).column), , xlYes).Name = "Table" & i
         'set style
        .ListObjects("Table" & i).TableStyle = "TableStyleLight9"

        'find next table range start
        Set rngStart = rngTable.End(xlDown).Offset(2)

        i = i + 1

    Loop Until rngStart.Row > lRow

End With

End Sub