Реализованный код в большую книгу и Loop through делает некоторые фанки-вещи Excel VBA

Во-первых, я очень новичок в vba и получил помощь в написании этих макросов, поэтому, пожалуйста, несите меня.

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

В книге имеется 32 листа. 26 из этих листов взаимодействуют друг с другом, и из них 26 каждый лист имеет 3 таблицы в общей сложности 78 таблиц.

Первый макрос:
Что он должен делать: когда пользователь вводит данные в 1 из 3 таблиц на своем конкретном листе и вводит количество в последней строке (не включая общую строку), должна появляться новая строка, позволяющая им продолжать вводить данные и формула заполняется.

Что это на самом деле делает: всякий раз, когда я нажимаю в любом месте таблицы, он автоматически добавляет две новые строки и не заполняет данные, и, в этом случае, он добавляет строки в середину таблицы и делает это для каждой таблицы на этом конкретном лист.

Второй макрос: что он должен делать: он находится в модуле, и я настроил его на сохранение. Он перебирает каждую таблицу в книге, удаляя строки, которые не содержат данных. Это вызов в этой ThisWorkbook но он не делает это при сохранении.

Первый макрос

 Private Sub Workbook_SheetSelectionChange(ByVal Sht As Object, ByVal Target As Range) 'Declaration of Variables Dim LastRow As Long Dim tbl As ListObject For Each tbl In Sht.ListObjects 'Set Lastrow LastRow = tbl.Range.Rows.Count LastRow = LastRow + tbl.HeaderRowRange.Row - 1 'Check - is someone entering in account name for the last open row If Sht.Range("B" & LastRow - 1) = "" Then 'User is not entering in account name in last open row 'do nothing Else 'User is entering in account name in last open row - create new row Application.EnableEvents = False 'turn off event handlers which allows sub to execute 'UNPROTECT SHEET CODE HERE tbl.DataBodyRange.Rows(tbl.DataBodyRange.Rows.Count).Insert Intersect(Sht.Range("B:L"), tbl.DataBodyRange.Rows(tbl.DataBodyRange.Rows.Count)).Insert 'PROTECT SHEET CODE HERE Application.EnableEvents = True 'turn on event handlers End If Next tbl End Sub 

Вот второй макрос

 Sub Delete_Table_Rows() Dim tbl As ListObject Dim i As Long Dim rowCount As Long Dim ws As Worksheet Application.ScreenUpdating = False For Each ws In ThisWorkbook.Worksheets For Each tbl In ws.ListObjects 'How many rows in the table? rowCount = tbl.DataBodyRange.Rows.Count 'Error checking If rowCount < 3 Then 'Not enough rows in table to do anything Exit Sub End If 'Since we're deleting rows, we'll loop backwards For i = rowCount - 2 To 1 Step -1 'Using Client column as reference point, it goes row by row 'And Resizes to be 4 cells wide when it looks for blank cells If WorksheetFunction.CountA(tbl.ListColumns(1).DataBodyRange.Cells(i).Resize(1, 4)) = 0 Then 'UNPROTECT SHEET CODE HERE tbl.DataBodyRange.Rows(i).Delete 'PROTECT SHEET CODE HERE End If Next i Next tbl Next ws Application.ScreenUpdating = True End Sub 

Предполагая, что у вас есть один столбец таблиц, выровненный по сторонам каждого листа, это должно делать то, что вы хотите. Всякий раз, когда последняя строка столбца «B» таблицы не пуста, она вставляет новую строку в таблицу. Обратите внимание, что это должно работать для случаев, когда у вас есть несколько таблиц, уложенных друг над другом с разными # столбцами. Это обеспечит минимум как минимум одной пустой строки между таблицами. Способ, которым это работает, заключается в том, что когда он обнаруживает таблицу под ним (например, столбец «B» ячейка 2 строки вниз находится в таблице) и собирается развернуть таблицу, чтобы занять эту пустую строку, она будет вставлять пустую строку, чтобы поддерживается один буфер строк между таблицами. Итак, мое обновление для вашего первого макроса:

 Public Function IsCellInTable(rng As Range) As Boolean IsCellInTable = Not rng.ListObject Is Nothing End Function Private Sub Workbook_SheetSelectionChange(ByVal Sht As Object, ByVal Target As Range) Dim LastRow As Long Dim tbl As ListObject For Each tbl In Sht.ListObjects LastRow = tbl.ListRows(tbl.ListRows.Count).Range.Row If Sht.Range("B" & LastRow) <> "" Then Application.enableEvents = False If IsCellInTable(Rows(LastRow + 2).Cells(1, 2)) Then Rows(LastRow + 1).EntireRow.Insert End If tbl.ListRows.Add alwaysinsert:=False Application.enableEvents = True End If Next tbl End Sub 

Чтобы вызвать вашу подпрограмму «Delete_Table_Rows» непосредственно перед сохранением, вы должны вызвать ее в «Workbook_BeforeSave» следующим образом:

 Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Delete_Table_Rows End Sub 

Обратите внимание, что ваша процедура удаления не будет работать, если таблицы на листе имеют разные столбцы. Чтобы заставить его работать в последнем случае, вы должны изменить эту строку:

 tbl.DataBodyRange.Rows(i).Delete 

к этому:

 tbl.DataBodyRange.Rows(i).EntireRow.Delete 
Interesting Posts

Как получить время завершения задачи в Outlook

Диапазон вариации VBA Match

Извлечение слова из строки, содержащей определенный символ в подстроке

Используйте Powershell, чтобы найти SSN в Word и Excell Documents

Обновить ссылку на ячейку с помощью макроса

Диапазон ввода из Excel в тело Outlook

Формула в Excel, которая ссылается на другой файл Excel на основе ссылки на ячейку

VBA – Проверка папки / файла существует в SharePoint

Определить интервал с известным общим количеством и количеством точек

Пытаясь сохранить файл слова, от excel vba, без перезаписи любых существующих файлов

Как перенести строку в Excel? т.е.: строка с 600 + столбцами, завернутая на одну страницу

Изменения в обзоре просмотрели мой проект VBA Unviewable

VBA: копирование всех данных на другой лист книги

Наиболее эффективный метод удаления строк с двумя условиями

Окраска несмежных блоков клеток быстро

Давайте будем гением компьютера.