實現代碼到大型工作簿和循環通過做一些時髦的東西Excel VBA

Question

首先，我對vba很新，並得到幫助寫這些宏，所以請忍受我。

我有兩個宏，理論上第一個宏應該在表格填滿時向表格添加一個新行，以便可以輸入附加數據，理論上第二個宏應該刪除這些宏額外的行作爲數據從它們中取出，所以表不會因空行而變得太大。

該工作簿有32張。這些表中有26個是用戶交互的，在這26個表中，每個表有3個表，總共78個表。

首先宏：
什麼它應該做的事：當用戶在其特定表3和表1輸入數據和他們在最後一行輸入金額（不包括總行）新行應該出現讓他們繼續輸入數據，公式填補。

它實際上在做什麼：每當我點擊表格中的任何位置時，它會自動添加兩個新行並且不會填充數據，因此，它將行添加到表的中間，併爲每個在該特定工作表上。

第二個宏： 它應該做什麼：它在一個模塊中，並且我將它設置爲保存。它循環遍歷工作簿中的每個表，刪除不包含數據的行。這是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 

Answer 1

假設你有排列下來每個工作表的邊桌的一列，這應該做你想做的。只要表格的'B'列的最後一行非空，它就會在表格中插入一個新行。請注意，這適用於您將多個表格以不同列數堆疊在一起的情況。它將確保表格之間至少有一個空行。這種方式的工作原理是，當它檢測到它下面的一個表（即列'B'cell 2 rows down in a table）並且即將擴展表以佔據這個空行時，它將插入一個空行，使得表格之間的一行緩衝區被保留。所以，我對你的第一個宏觀的更新是這樣的：

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