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

我在一个名为

tbl\u raw

的表中有99列。我需要将其中96列复制到另一个具有相同标题名的表中，但它们的排列顺序不同。最有效的方法是什么

我知道的唯一方法是：

raw_data.Range（“tbl_raw[EMPLOYEE]”）。复制
已处理数据。范围（“待处理[员工]”）。粘贴特殊

然而，这需要大量的代码（96*2=192行），我不确定是否有更有效的方法来完成

我试图使用，但我也找不到一种方法来使用这些信息

---

任何指导都将不胜感激。

这里有一个基本示例，可以将一个表中除某些列外的所有列复制到另一个表中：

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

---

避免复制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

---

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

---

循环通过ListObject（“tbl_processed”）.HeaderRowRange收集ListObject（“tbl_raw”）.HeaderRowRange中的每个匹配列。不清楚您是在附加还是替换tbl_processed中的数据。我正在替换数据。我要做的第一件事是清除表中除第一行数据以外的内容，因为我可能会添加一些带有公式的列。我不确定如何实现您的解决方案。我不是VBA的高手，但我已经创建了一些脚本，并且一直在实践中学习。它会是这样的：`如果tbl_raw.headerrorwrange=tbl_processed.headerrorwrange，那么。。。我不确定如何动态地实现这一点。我想我会遵循这一点。我试图在脚本中执行该代码，但无法使其正常工作。我假设

应用程序.Match

检查tbl1中列的名称。但是，我看不出它在哪里与tbl2相匹配。我也不理解那里的“数组”函数<代码>为tbl_raw.ListColumns中的每个h设置h作为ListColumns的Dim h如果IsError（Application.Match（h.Name，Array（“col10”，“col11”），0）），则h.DataBodyRange.Copy tbl_imd.ListColumns（h.Name）。DataBodyRange（1）结束，如果下一个h，感谢您的回复，并感谢您的进一步帮助

Array（）

仅从参数创建一个数组-之所以使用它是因为Match需要一个数组来查找。对于表2的匹配，它假设列名相同，

tbl2.ListColumns（h.Name）.DataBodyRange（1）

将粘贴目标作为表2列中标题为

h.Name

的第一个单元格，我认为op希望复制标题匹配的列，而不是不匹配的列。您的查找数组中还必须有96个元素，这样使用

tbl1.HeaderRowRange

可能会更容易。我想我理解OP的要求，我的数组只需要三个“请勿复制”标题…抱歉，在上面的帖子之前我已经做了一段时间了。太好了！我真的很感谢你的评论和批评。我真的希望尽可能多地学习，这对我很有帮助！我也将开始剖析这段代码，看看每件事是如何工作的。你怎么说这个解决方案是相对于@user11198948发布的解决方案的？我的代码没有清除目标表。我的代码根据需要添加行。我不知道user11198948的代码是否更快（我现在没有Microsoft Office），但我对我的代码进行了编码以允许修改，这样您就可以了解发生了什么（我自学成才，回忆起困难）。GetColumnTranslations允许您返回自定义关联数组。（我仍在学习此网站。）若要复制格式，请尝试在注释“Value may copy formula”=>Let zDestinationRow（0，zTranslationVar（1））。Style=zSourceRowVar（0，zTranslationVar（0））。Style尽可能是学习最佳实践的地方。。。使用“”研究您需要什么，因为这是我从上面获取信息的地方。评论每件事，这样你和其他人就可以快速阅读它的作用，即使你逐字逐句地重复它。保持简单。当事情变得复杂时，不要害怕把它拆开（就像我在上面的解决方案中所做的那样）。这些都是我做的。这很有效！它也非常快，比复制和粘贴要快得多。我有一个问题，列的格式正在丢失。我有'001'的值，我需要它们保持为字符串，但它们正在转换为数字。在使用直接值传输方法时，是否仍有保留值格式的方法？我甚至还没有开始剖析你的代码来理解它。我希望在我试图详细理解它之后，我能问一些澄清的问题！我真的很感激你的回答！