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

在大型工作簿中实现代码，Loop through正在做一些时髦的东西Excel VBA

0 个答案: