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