VBAmacros将行删除到默认表大小

我有一个macros，将添加行作为第二行的表底部填满了，但我想添加第二个macros来调整表的大小为12行和11列，当表超过12行，没有数据在额外的行中。

这里是macros添加行：

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'Declaration of Variables Dim sht As Worksheet Dim LastRow As Long 'Set sht as worksheet Set sht = ThisWorkbook.Worksheets("Sheet2") 'Set Lastrow LastRow = sht.ListObjects("Table1").Range.Rows.Count LastRow = LastRow + 4 'Check - is someone entering in account name for the last open row If Me.Range("B" & LastRow - 1) = "" Then 'User is not entering in account name in last open row, exit sub Exit Sub 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 Rows(LastRow).Select 'select the summary row Selection.EntireRow.Insert 'insert row above ActiveSheet.Range("F" & LastRow & ":L" & LastRow).Select 'select formulas only Selection.FillDown 'fill the formulas in ActiveSheet.Range("C" & LastRow - 1).Select 'on the row that is being entered, select Pipeline Stage Cell Application.EnableEvents = True 'turn on event handlers End If End Sub 

我发现这个macros在线，但我似乎无法操纵它做我想要的，我想要macros调整表格12列11列当L14 <1

 Sub DeleteBlankRows1() 'Deletes the entire row within the selection if the ENTIRE row contains no data. 'We use Long in case they have over 32,767 rows selected. Dim i As Long 'We turn off calculation and screenupdating to speed up the macro. With Application .Calculation = xlCalculationManual .ScreenUpdating = False 'We work backwards because we are deleting rows. For i = Selection.Rows.Count To 1 Step -1 If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then Selection.Rows(i).EntireRow.Delete End If Next i .Calculation = xlCalculationAutomatic .ScreenUpdating = True End With End Sub 

Answer 1

你可以尝试这样的事情…

 Sub DeleteTableRows() Dim ws As Worksheet Dim tbl As ListObject Dim r As Long, c As Long Set ws = Sheets("Sheet2") Set tbl = ws.ListObjects("Table1") For r = tbl.DataBodyRange.Rows.Count To 12 Step -1 If Application.CountIf(tbl.DataBodyRange.Rows(r), "?*") = 0 Then tbl.ListRows(r).Delete End If Next r For c = tbl.DataBodyRange.Columns.Count To 12 Step -1 tbl.ListColumns(c).Delete Next c End Sub 

如果你想包括一个IF语句来检查表格行，你可以尝试这样的…

 Sub DeleteTableRows() Dim ws As Worksheet Dim tbl As ListObject Dim r As Long, c As Long, tblRows As Long Set ws = Sheets("Sheet2") Set tbl = ws.ListObjects("Table1") tblRows = tbl.DataBodyRange.Rows.Count If tblRows > 12 Then For r = tbl.DataBodyRange.Rows.Count To 12 Step -1 If Application.CountIf(tbl.DataBodyRange.Rows(r), "?*") = 0 Then tbl.ListRows(r).Delete End If Next r For c = tbl.DataBodyRange.Columns.Count To 12 Step -1 tbl.ListColumns(c).Delete Next c End If End Sub