Как создать таблицу, которая изменяет размер на основе определенного значения - PullRequest
Новая
       6

Как создать таблицу, которая изменяет размер на основе определенного значения

0 голосов
/ 17 декабря 2018

VBA CODE:
У меня есть ряд таблиц (по одной на лист), которые необходимо динамически увеличивать или уменьшать в размере на основе числа, введенного пользователем (на другом листе).

Каждая строка в каждой из таблиц должна поддерживать форматирование и формулы из приведенных выше строк, пока они «вставляются».

Я использовал приведенные ниже данные для успешного увеличения размера таблицы с правильным форматированием., но это только добавляет строки в таблицу ... и если кто-то нажимает кнопку макроса несколько раз, мы можем получить слишком много строк.Поэтому я хочу использовать динамическую таблицу, в которой строки определяются числом, и не имеет значения, был ли кто-то доволен кликом.

Я также предпринял еще одну попытку, которая увеличивает размер таблицы, ноон не вставляет дополнительные строки, поэтому таблица перекрывает данные, которые находятся в строках ниже определенной таблицы.Эта попытка также не копирует форматирование ... но это все, что у меня есть.Буду признателен за любую помощь, я работаю над этим пару месяцев и не могу найти подходящий ответ (после нескольких дней поиска). 

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 голосов
/ 26 декабря 2018

На вашем месте я бы изменил все на таблицы, чтобы все (строки и столбцы) обновлялись автоматически.

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

Ctrl+T: Этот ярлык преобразует диапазонсоответствующей информации в таблицу Excel.Чтобы использовать этот ярлык, сначала выберите любую ячейку в диапазоне связанных данных.

0 голосов
/ 17 декабря 2018

Лучшим подходом будет использование 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
...