将输入添加到表格底部

debugcn 发表于 Dev

尼古拉斯

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

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

'================================================================
'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

本文收集自互联网，转载请注明来源。

如有侵权，请联系[email protected] 删除。