Question

我有一个宏将添加行，因为表的第二行到底被填满但我想添加第二个宏来将表调整为12行和11列，当表超过12行时附加行中没有数据。

以下是添加行的宏：

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

我在网上找到了这个宏但是我似乎无法操纵它来做我想要的事情，我希望宏在L14＆lt; L14＆lt; L14＆lt; 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

VBA宏将行删除为默认表大小

1 个答案: