更新具有相似相同 header 的不同表数据

Question

我从一个来源 table 数据更新了不同工作表中的几个 tables，这些数据具有相似的标题，而目标 tables 有一些额外的 headers。

我使用的是下面的 VBA 代码，但是如果我要交换 header 就非常困难。

 
    
   
    lastRow = Sheets("Data Sheet").Range("D" & Rows.Count).End(xlUp).Row
    Sheets("Report").Range("B8:B" & lastRow).Value = Sheets("Data Sheet").Range("D8:D" & lastRow).Value
    
    
    lastRow = Sheets("Data Sheet").Range("F" & Rows.Count).End(xlUp).Row
    Sheets("Report").Range("C8:C" & lastRow).Value = Sheets("Data Sheet").Range("F8:F" & lastRow).Value
    
    
    lastRow = Sheets("Data Sheet").Range("H" & Rows.Count).End(xlUp).Row
    Sheets("Report").Range("E8:E" & lastRow).Value = Sheets("Data Sheet").Range("H8:H" & lastRow).Value
    
    
    lastRow = Sheets("Data Sheet").Range("E" & Rows.Count).End(xlUp).Row
    Sheets("Report").Range("F8:F" & lastRow).Value = Sheets("Data Sheet").Range("E8:E" & lastRow).Value

有没有更好的方法根据tableheader更新数据？

提前致谢:)

Answer 1

这将执行您要查找的操作，它遍历源列，在目标中找到该列 sheet，然后将该列粘贴到上面（这可以通过粘贴整个列而不是粘贴来简化查找最后一行并仅复制范围，但如果需要，您可以弄清楚:)更改常量声明以适合您的情况。

Const SourceSheetName = "Sheet28"
Const DestinationSheetName = "Sheet29"
Const HeaderRow = 1

Dim wss As Worksheet
Dim wsd As Worksheet

Sub CopyByHeader()
    Set wss = Sheets(SourceSheetName)
    Set wsd = Sheets(DestinationSheetName)
    SourceColCount = wss.Cells(HeaderRow, 1).End(xlToRight).Column
    DestColCount = wsd.Cells(HeaderRow, 1).End(xlToRight).Column
    wsd.Rows("2:1000000").Clear
    For SourceCol = 1 To SourceColCount
        HeaderText = wss.Cells(HeaderRow, SourceCol)
        DestCol = 1
        Do Until wsd.Cells(HeaderRow, DestCol) = HeaderText
            DestCol = DestCol + 1
            If DestCol > DestColCount Then
                MsgBox "Can't find the header " & HeaderText & " in the destination sheet!", vbCritical, "Ahh Nuts!"
                Exit Sub
            End If
        Loop
        SourceLastRow = wss.Cells(1000000, SourceCol).End(xlUp).Row
        wss.Range(wss.Cells(HeaderRow + 1, SourceCol), wss.Cells(SourceLastRow, SourceCol)).Copy wsd.Cells(HeaderRow + 1, DestCol)
    Next SourceCol
End Sub

Answer 2

我终于得到了自己的灵活代码。如果您有任何其他方式，请告诉我再次感谢:)

Sub updatetbl()
Application.ScreenUpdating = False
Dim col As Range, col1 As Range
Dim source As Worksheet, dest As Worksheet
Dim i As String, j As Integer
Set source = Sheets("Data")
Set dest = Sheets("Report")
' setting table headers as range
Set col = source.Range("Data[#Headers]")
Set col1 = dest.Range("Report[#Headers]")

For Each cell In col

    For Each cell1 In col1
    i = cell.Value
    If cell.Value = cell1.Value Then
    source.Select
    ' selecting matched table header column 
    Range("Data[" & i & "]").Copy
    dest.Select
    cell1.Offset(1, 0).Select
    ' pasting the respective data under destination header
    ActiveSheet.Paste
    End If
    Next cell1
Next cell
Application.ScreenUpdating = True
End Sub

更新具有相似相同 header 的不同表数据

Updating different tables data which has similar same header

excel

vba

excel-2007