将输入添加到表底部

  • 本文关键字:底部 添加 excel vba
  • 更新时间 :
  • 英文 :


我有一个用于输入数据的主表和一个用于获取该数据并将其放入表中的按钮。

当我将数据输入表中时,它会留下一个空白行。如何在没有此问题的情况下将数据插入表中?

'================================================================
'Button on MASTER sheet
'Functions: inputs new digsafe data into LIST sheet
'================================================================
Sub add_to_list()
Dim wsMaster As Worksheet: Set wsMaster = Worksheets("MASTER")
Dim wsList As Worksheet: Set wsList = Worksheets("LIST")
Dim table_list_object As ListObject: Set table_list_object = 
wsList.ListObjects("Table1")
Dim table_object_row As ListRow: Set table_object_row = 
table_list_object.ListRows.Add
Dim digsafe As Long
Dim workType As String, crossStreet As String, address As String
Dim dateTime As Date
digsafe = wsMaster.Range("C5").Value                'Stores values inputted by user
dateTime = wsMaster.Range("C6").Value
workType = wsMaster.Range("C7").Value
crossStreet = wsMaster.Range("C8").Value
address = wsMaster.Range("C9").Value
wsList.Activate
table_object_row.Range(1, 1).Value = digsafe        'Inputs data at end of the table (Table1)
table_object_row.Range(1, 2).Value = dateTime
table_object_row.Range(1, 3).Value = workType
table_object_row.Range(1, 4).Value = crossStreet
table_object_row.Range(1, 5).Value = address
For Each Cell In wsMaster.Range("C5:C9")            'Clears data from DS Input after entered
Cell.Value = ""
Next
End Sub

OP 的代码没有为我添加空行。 我重写了代码以确保有有效的输入数据并删除表中的任何空行。

Sub add_to_list()
Dim Source As Range, Target As Range
Set Source = Worksheets("MASTER").Range("C6").Resize(5)
If WorksheetFunction.CountA(Source) = 0 Then Exit Sub
Set Target = Worksheets("LIST").ListObjects("Table1").ListRows.Add.Range(1, 1).Resize(1, 5)
Target.Value = WorksheetFunction.Transpose(Source.Value)
Source.ClearContents
DeleteEmptyRowsFromList
End Sub
Sub DeleteEmptyRowsFromList()
Dim r As Long
With Worksheets("LIST").ListObjects("Table1").DataBodyRange
For r = .Rows.count To 1 Step -1
If WorksheetFunction.CountA(.Rows(r)) = 0 Then .Rows(r).Delete Shift:=xlUp
Next
End With
End Sub

.对象具有 Range 属性。因此,如果您将值设置为此范围属性,它也会将其添加到新行中的表中,而无需删除行左右:

Sub tt()
Dim tbl As ListObject
Dim t_row As ListRow
Dim v
For Each tbl In SheetAdminLog.ListObjects
Debug.Print tbl.ListRows.Count
v = Range("A1:N1").Value
Set t_row = tbl.ListRows.Add
Debug.Print t_row.Range.Address
t_row.Range.Value = v
Next
End Sub

最新更新