如何从单元格复制并粘贴到不同的新行 table VBA

Question

我正在尝试执行以下操作：

检查 sheet1 中 table1 中的“订单”列是否为空的每一行（此 sheet 中只有一个 table）
如果“订单”列为空，请从同一行复制“通知”编号，然后将其粘贴到另一个 table (table2) 的新行中sheet (sheet2) 在“通知”栏下。
如果不为空，则转到table1

到目前为止我有以下代码：

For Each TCell in Range ("Table1").ListObject.ListColumns("Order").DataBodyRange.Cells
    If TCell.Value="" then
    Table2.ListRows.Add AlwaysInsert:=True
    Range(TCell.Row, "Notification").Copy Range("Table2") .ListObject. ListColumns ("Notification" 
    .DataBodyRange.End(xlDown).Offset (1,0)
    End if
Next TCell

如有任何帮助，我们将不胜感激！谢谢

Answer 1

将 Table 的列附加到另一个 Table 的列

这是一个基本的解决方案，'literally' 可以满足要求（慢）。通过使用对象变量来说明它们的应用。
您可以通过引入数组来提高效率，尤其是通过使用 AutoFilter。

Option Explicit

Sub AppendNotifications()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim sws As Worksheet: Set sws = wb.Worksheets("Sheet1")
    Dim stbl As ListObject: Set stbl = sws.ListObjects("Table1")
    Dim slcl As ListColumn: Set slcl = stbl.ListColumns("Order")
    Dim svcl As ListColumn: Set svcl = stbl.ListColumns("Notification")
    
    Dim scOffset As Long: scOffset = svcl.Index - slcl.Index

    Dim dws As Worksheet: Set dws = wb.Worksheets("Sheet2")
    Dim dtbl As ListObject: Set dtbl = dws.ListObjects("Table2")
    Dim dvcl As ListColumn: Set dvcl = dtbl.ListColumns("Notification")
    
    Dim dvCol As Long: dvCol = dvcl.Index
    
    Dim sCell As Range
    Dim dvrw As ListRow
    
    For Each sCell In slcl.DataBodyRange
        If Len(sCell.Value) = 0 Then
            Set dvrw = dtbl.ListRows.Add
            dvrw.Range(dvCol).Value = sCell.Offset(, scOffset).Value
        End If
    Next sCell
    
    MsgBox "Notifications appended.", vbInformation

End Sub

Answer 2

可以试试下面的代码：

Sub transform()
    Dim cell        As Range
    Set rng1 = Sheet1.Range("Table1[Order]")
    Set SheetTwo = ActiveWorkbook.Worksheets("Sheet2")
    Set TableTwo = SheetTwo.ListObjects("Table2")
        
    For Each cell In rng1
        
        If Not IsEmpty(cell.Offset(0, 0).Value) Then
            Dim newrow As ListRow
            Set newrow = TableTwo.ListRows.Add
            With newrow
                .Range(1) = cell.Offset(0, 1).Value
            End With
        End If
        
    Next cell
End Sub

代码为 self-explanatory。

注意事项：表2只有一列。

如何从单元格复制并粘贴到不同的新行 table VBA

How to copy from a cell and paste in a new row of a different table VBA

excel

vba

copy

paste

excel-tables

将 Table 的列附加到另一个 Table 的列