VBA Excel - 循环创建表的工作表 [英] VBA Excel - Loop through worksheet creating tables

问题描述

创建此宏以遍历整个工作表，并将每个部分格式化为具有特定格式的表格。

我试图循环遍历整个工作表，并将每个部分格式化为表格。

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

任何想法？

  Sub Macro8（）
 Range（A3：B4）。选择
 ActiveSheet.ListObjects。添加（xlSrcRange，Range（$ A $ 3：$ B $ 4），xlYes）.Name = _ 
Table6
 Range（Table6 [#All]）。选择
 ActiveSheet.ListObjects（Table6）TableStyle =TableStyleLight9
 
 Selection.End（xlDown）.Select 
 Selection.End（xlDown）.Select 
 Range（ A6：B7）。选择
 ActiveSheet.ListObjects.Add（xlSrcRange，Range（$ A $ 6：$ B $ 7），，xlYes）.Name = _ 
Table7
范围（Table7 [#All]）。选择
 ActiveSheet.ListObjects（Table7）。TableStyle =TableStyleLight9
 
 Selection.End（xlDown）.Select 
 Selection.End（xlDown）.Select 
 Range（A9：D22）。选择
 ActiveSheet.ListObjects.Add（xlSrcRange，Range（$ A $ 9：$ D $ 22），，xlYes） 。$ _ 
Table8
 Range（Table8 [#All]）。选择
 ActiveSheet.ListObjects（Table8）。TableStyle =TableStyleLight9
 
 Selection.End（xlDown）。选择
 Selection.End（xlDown）。选择
范围（A24：D37）。选择
 Ac tiveSheet.ListObjects.Add（xlSrcRange，Range（$ A $ 24：$ D $ 37），，xlYes）.Name = _ 
Table9
 Range（Table9 [#All]）。选择
 ActiveSheet.ListObjects（Table9）TableStyle =TableStyleLight9
 
 End Sub 
  

$ b $

  Sub MakeTables（ ）
 
 Dim ws As Worksheet 
设置ws =工作表（Sheet1）'根据需要更改
 
使用ws 
 
'find列A中的最后一行数据
 Dim lRow As Long 
 lRow = .Range（A& .Rows.Count）.End（xlUp）.Row 
 
 Dim rngStart As Range 
设置rngStart = .Range（A3）
 
'设置计数器变量用于命名表
 Dim i As Long 
i = i + 1 
 
 Do 
 
'创建表范围
设置rngTable = .Range rngStart，rngStart.End（xlDown））
 
'创建表
 .ListObjects.Add（xlSrcRange，rngTable.Resize（rngTable.Rows.Count，rngStart.End（xlToRight）.column） ，xlYes）.Name =Table& i 
'set style 
 .ListObjects（Table& i）.TableStyle =TableStyleLight9
 
'查找下一个表范围开始
设置rngStart = rngTable .End（xlDown）.Offset（2）
 
i = i + 1 
 
循环直到rngStart.Row> lRow 
 
结束
 
结束子
  

Created this macro to go through the entire worksheet and format each section as a table with a specific format.

I'm trying to loop through the entire worksheet where and format each section as a table.

Each section is separated by one blank row.

Any ideas?

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

解决方案

Give this a shot:

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

这篇关于VBA Excel - 循环创建表的工作表的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！