Question

我在一个名为tbl_raw的表中有99列。我需要将这些列中的96列复制到具有完全相同的标头名称的另一个表中，但是它们以不同的顺序重新排列。最有效的方法是什么？

我唯一知道的方法是：

raw_data.Range("tbl_raw[EMPLOYEE]").Copy processed_data.Range("tbl_processed[EMPLOYEE]").PasteSpecial

但是，这将需要很多代码（96 * 2 = 192行），我不确定是否有更有效的方法来实现。

我尝试使用https://www.thespreadsheetguru.com/blog/2014/6/20/the-vba-guide-to-listobject-excel-tables，但是我也找不到解决该信息的方法。

任何指导将不胜感激。

Answer 1

这是将一个表中除某些列之外的所有列都复制到另一个表的基本示例：

Dim tbl1 As ListObject, tbl2 As ListObject
Dim h As ListColumn

Set tbl1 = ActiveSheet.ListObjects("Table1")
Set tbl2 = ActiveSheet.ListObjects("Table2")

'loop over the headers from the source table
For Each h In tbl1.ListColumns
    'is the column name in the "excluded" list?
    If IsError(Application.Match(h.Name, Array("col10", "col11"), 0)) Then

        'ok to copy...
        h.DataBodyRange.Copy tbl2.ListColumns(h.Name).DataBodyRange(1)

    End If
Next h

Answer 2

避免处理复制ListObject列，并使用直接值传递。

Option Explicit

Sub raw2processed()

    Dim lc As Long, mc As Variant, x As Variant
    Dim raw_data As Worksheet, processed_data As Worksheet
    Dim raw_tbl As ListObject, processed_tbl As ListObject

    Set raw_data = Worksheets("raw")
    Set processed_data = Worksheets("processed")
    Set raw_tbl = raw_data.ListObjects("tbl_raw")
    Set processed_tbl = processed_data.ListObjects("tbl_processed")

    With processed_tbl
        'clear target table
        On Error Resume Next
        .DataBodyRange.Clear
        .Resize .Range.Resize(raw_tbl.ListRows.Count + 1, .ListColumns.Count)
        On Error GoTo 0

        'loop through target header and collect columns from raw_tbl
        For lc = 1 To .ListColumns.Count
            Debug.Print .HeaderRowRange(lc)
            mc = Application.Match(.HeaderRowRange(lc), raw_tbl.HeaderRowRange, 0)
            If Not IsError(mc) Then
                x = raw_tbl.ListColumns(mc).DataBodyRange.Value
                .ListColumns(lc).DataBodyRange = x
            End If
        Next lc

    End With

End Sub

Answer 3

ForEach / For是使用数组和集合的魔力。有一些方法可以使以下代码更有效，但是我认为这可能会妨碍您理解正在发生的事情。自从我上一次与VBA合作以来，已经有大约6个月了，但是我相信这应该可以工作。我建议单步执行并观察您的本地人，看看发生了什么事。如果变量分配存在问题，则可能需要将“ Let”更改为“ Set”。代码如下：

'// PROBLEM:
'// Copy data from one list to a second list.
'// Both lists have the same column names and the same number of columns.
'// Copy data based on the column name.

'// Modify to return a custom source-destination association.
Private Function GetColumnTranslations(zLeftColumns As ListColumns, zRightColumns As ListColumns) As Variant
  Dim zReturn(,) As Variant
  ReDim zReturn(0 To zLeftColumns.Count As Long, 0 To 1 As Long)
  Dim zReturnOffset As Long '// Specifies what index we are working at during our ForEach interations.  

  Dim zLeftVar As Variant
  Dim zRightVar As Variant

  ForEach zLeftVar in zLeftColumns
    '// Go through each 'left' column to Find the first 'right' column that matches the name of the 'left' column.
    '// Only the first 'right' column with a matching name will be used. Issue is solved with another ForEach, but beyond forum question's scope.
    ForEach zRightVar in zRightColumns

      If zLeftVar.Name = zRightVar.Name Then

        '// Store the association and exit the nested ForEach.
        Let zReturn(zReturnOffset, 0) = zLeftVar.Range.Column '// Source.
        Let zReturn(zReturnOffset, 1) = zRightVar.Range.Column '// Destination.
        Let zReturnOffset = zReturnOffset + 1

        Exit ForEach
      End If
    Next zRightVar
  Next zLeftVar

  '// Assign return value.
  Let GetColumnTranslations = zReturn
End Function


'// Take each source row and copy the value to a new destination row.
'// New rows are added to the end of the destination list.
Public Sub CopyList(zSourceList As ListObject, zDestinationList As ListObject)
  Dim zColumnTranslations As Variant '// Will be 2-dimensional array.
  Dim zTranslationVar As Variant '// Will be array of 2 elements. 
  Let zColumnTranslations = GetColumnTranslations(zSourceList.Columns, zDestinationList.Columns)

  Dim zSourceRowVar As Variant '// Will translate to Range.
  Dim zDestinationRow As Range

  '// Every source row needs copied to a new row in destination.
  ForEach zSourceRowVar in zSourceList.Rows
    Set zDestinationRow = zDestinationList.Rows.Add.Range

    ForEach zTranslationVar in zColumnTranslations
      '// Value may copy formula.
      Let zDestinationRow(0,zTranslationVar(1)).Value = zSourceRowVar(0,zTranslationVar(0)).Value
    Next zTranslationVar
  Next zSourceRowVar
End Sub

VBA将数据从一个表复制到另一个表并重新排列列

3 个答案: