如何创建一个根据确定的值更改大小的表

时间:2018-12-16 23:29:48

标签: excel vba dynamic

VBA代码:
 我有一系列表格(每张一张),需要根据用户(在另一张上)输入的数量动态地增加或减少大小。

每个表中的每一行都需要在“插入”的同时保持上面各行的格式和公式。

我已使用以下内容以正确的格式成功增加了表格的大小,但这只会向表格中添加行。如果有人多次单击宏按钮,我们可能会得到太多行。因此,为什么我想要一个动态表,其中的行由数字确定,而有人单击是否满意则无关紧要。

我还做了另一种尝试,它的确增加了表的大小,但是它没有插入其他行,因此该表与已确定表下方的行中的数据重叠。这种尝试也不会复制格式...但是这就是我到目前为止所拥有的全部。任何帮助将不胜感激,我已经研究了几个月,却找不到合适的答案(经过几天的搜索)。

Sub InsertNumberOfRows()

Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Dim NBOFROWS As Range
Dim wkb As Workbook


Set NBOFROWS = Worksheets("Rates").Range("K4")


Set wkb = Workbooks("POD Automation10.1")

With wkb

Set sh1 = ActiveWorkbook.Sheets("POD Cost Plan")
Set sh2 = ActiveWorkbook.Sheets("Development Calculator")
Set sh3 = ActiveWorkbook.Sheets("Calculator Calculations")


sh1.Select
Rows("10:10").Select
Selection.EntireRow.Offset(1).Resize(NBOFROWS.Value).Insert Shift:=xlDown, 
CopyOrigin:=xlFormatFromLeftOrAbove

sh2.Select
Rows("10:10").Select
Selection.EntireRow.Offset(1).Resize(NBOFROWS.Value).Insert Shift:=xlDown, 
CopyOrigin:=xlFormatFromLeftOrAbove

sh3.Select
Rows("10:10").Select
Selection.EntireRow.Offset(1).Resize(NBOFROWS.Value).Insert Shift:=xlDown, 
CopyOrigin:=xlFormatFromLeftOrAbove

End With


End Sub



NEXT ATTEMPT:


Sub InsertNumberOfRows()

Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Dim Value As Range
Dim wkb As Workbook
Dim rng As Range
Dim tbl As ListObject

Set Value = Worksheets("Rates").Range("K4")

Set wkb = Workbooks("POD Automation10.2")

With wkb

Set sh1 = ActiveWorkbook.Sheets("POD Cost Plan")
Set sh2 = ActiveWorkbook.Sheets("Development Calculator")
Set sh3 = ActiveWorkbook.Sheets("Calculator Calculations")


sh1.Select

  Set tbl = ActiveSheet.ListObjects("POD_CostPlan_Tbl")

 Set rng = Range("POD_CostPlan_Tbl[#All]").Resize(tbl.Range.Rows.Count + Value, tbl.Range.Columns.Count)

  tbl.Resize rng


sh2.Select

Set tbl = ActiveSheet.ListObjects("TBL_UserEntry")

  Set rng = Range("TBL_UserEntry[#All]").Resize(tbl.Range.Rows.Count + Value, tbl.Range.Columns.Count)

 tbl.Resize rng


sh3.Select

Set tbl = ActiveSheet.ListObjects("TBL_Calculations")

  Set rng = Range("TBL_Calculations[#All]").Resize(tbl.Range.Rows.Count + Value, tbl.Range.Columns.Count)

  tbl.Resize rng

End With


End Sub

2 个答案:

答案 0 :(得分:0)

更好的方法是使用ListObject属性来添加行和列。例如:

 With ActiveSheet.ListObjects("Table1")
     ' Insert column at the end of table:
      .ListColumns.Add
     ' Add row tp the bottom of table:
      .ListRows.Add AlwaysInsert:= True
 End With

答案 1 :(得分:0)

如果我是您,我会将所有这些都更改为Tables,以便所有内容(行和列)都将自动更新。

https://www.thespreadsheetguru.com/blog/2014/6/20/the-vba-guide-to-listobject-excel-tables

@SystemApi此快捷方式将一系列相关信息转换为Excel表。要使用此快捷方式,只需先选择一系列相关数据中的任何单元格即可。