实现代码到大型工作簿和循环通过做一些时髦的东西Excel VBA
首先，我对vba很感兴趣，并且帮助编写这些macros，请耐心等待。
我有两个macros，理论上讲，第一个macros应该在表格填满时添加一个新行，这样可以input额外的数据，理论上第二个macros应该删除这些额外的行作为数据会从中取出，所以表格不会因为空行而变得太大。
该工作簿有32张。 这些表中的26个是用户交互的，在这26个表中，每个表有3个表，总共78个表。
第一个macros：
它应该做什么：当用户在其特定工作表中的3个表格中的1个表格中input数据，并且在最后一行（不包括总行）中input一个数量时，应该出现一个新行，允许他们继续input数据公式填补。
它实际上在做什么：每当我点击表中的任何位置时，它会自动添加两行，并且不会填充数据，因此，它将行添加到表中，并针对该表上的每个表执行此操作片。
第二个macros：它应该做什么：它在一个模块中，我把它设置为保存。 它循环遍历工作簿中的每个表，删除不包含数据的行。 这是ThisWorkbook的一个调用，但不是在保存时进行的。
第一个macros
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
这是第二个macros
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'列的最后一行非空，它将在表格中插入一个新行。 请注意，这应该适用于您将多个表格以不同列数堆叠在一起的情况。 这将确保表格之间至less有一个空行。 这种方式的工作原理是，当它检测到它下面的一个表（即列'B'cell 2 rows down in a table），并且即将扩展表占据这个空行时，它将插入一个空行，表格之间的一行缓冲区被保留。 所以我的第一个macros的更新是这样的：
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