使用VBA合并Excel表格

Question

我有一张Excel表格（Say OG.xls），其中已包含一些数据，其中第一行有5000行，标题为“AN”列。 行数（5000）一年内没有变化。 现在我有5个XL文件（说A，B，C，D，E），这些文件中的数据必须每次从第5001行开始附加到这个OG文件。 所有这5个文件都有不同的列，但与OG文件的列相同。 我必须从这些文件中提取数据并将它们放在OG文件中。 从文件A：列A，B，C，D，E，F，G＆amp; H进入OG.xls文件的列F，G，T，U，V，W，X和Y. 同样，必须根据OG.xls

的相应列提取其他文件数据

第二个文件数据必须附加在文件A结束的下一行的正下方。（在填写文件A中的数据之后，现在说OG.xls有5110行， 文件B数据必须从第511行的OG.xls中填充。 其他文件也是如此。 这5个文件的数据必须一行一行地填充，但应该与OG.xls

的列匹配

每次通过填充第5001行OG.xls中的数据重复相同的操作。为方便起见，我们可以将所有这些文件放在同一个文件夹中。

我们怎么做呢。

请帮助我!!! 如有任何澄清，请与我联系。

Answer 1

如果你需要一个更好的答案，你需要先尝试一下，然后在你遇到困难的地方寻求帮助。我的建议是你开始; 1.开始在OG.XLS中编写VBA脚本，作为第一步尝试访问文件A.xls并读取列并粘贴它们（它们最初可以在任何位置以任何顺序）。 2.一旦能够执行此操作，下一步是查看是否将数据放在右列（在示例中为5000），方法是设置正确的变量并使用它们并递增它们。 3.下一步应该是阅读A.XLS中的列标题并找到它们OG.XLS并识别它们。最初你可以先做一个简单的字符串比较，然后你可以改进它来做一个VLOOKUP。 4.在此过程中，如果遇到任何特定问题，请提出以便获得更好的答案。

社区中很少会为您编写整个代码。

Answer 2

为什么A列最终在F列中，为什么C在T中结束？是否有一个规则，例如第一行是一个带有相同文本的标题？

也许照片可能会有所帮助。

根据我的猜测，我会将每张表格放入一个带有意义字段名称的RecordSet中（您需要引用Microsoft ActiveX Data Objects 2.8 Library）。一旦完成，将很容易附加每个RecordSet并将它们放入一张表中。

您需要能够找到每张表格中的最后一列和最后一行才能干净地完成此操作，所以请查看How can i find the last row...

修改...

下面是一个清理过的示例，说明如何在VBA中执行所需操作。魔鬼在细节中，例如空表，以及如何处理公式（这完全忽略它们），以及如何以适当的方式合并列（再次忽略）。

这已在Excel 2007中测试过。

Option Explicit
Const MAX_CHARS = 1200



Sub MergeAllSheets()
  Dim rs As Recordset
  Dim mergedRS As Recordset
  Dim sh As Worksheet
  Dim wb As Workbook

  Dim fieldList As New Collection
  Dim rsetList As New Collection

  Dim f As Variant
  Dim cols As Long
  Dim rows As Long
  Dim c As Long
  Dim r As Long

  Dim ref As String
  Dim fldName As String
  Dim sourceColumn As String



  Set wb = ActiveWorkbook
  For Each sh In wb.Worksheets
    Set rs = New Recordset
    ref = FindEndCell(sh)
    cols = sh.Range(ref).Column
    rows = sh.Range(ref).Row

    If ref <> "$A$1" Or sh.Range(ref).Value <> "" Then '' This is to catch empty sheet
      c = 1
      r = 1
      Do While c <= cols
        fldName = sh.Cells(r, c).Value
        rs.Fields.Append fldName, adVarChar, MAX_CHARS
        If Not InCollection(fieldList, fldName) Then
          fieldList.Add fldName, fldName
        End If
        c = c + 1
      Loop
      rs.Open


      r = 2
      Do While r <= rows
        rs.AddNew
        c = 1
        Do While c <= cols
          rs.Fields(c - 1) = CStr(sh.Cells(r, c).Value)
          c = c + 1
        Loop
        r = r + 1
        Debug.Print sh.Name & ": " & r & " of " & rows & ", " & c & " of " & cols
      Loop
      rsetList.Add rs, sh.Name
    End If
  Next


  Set mergedRS = New Recordset
  c = 1
  sourceColumn = "SourceSheet"
  Do While InCollection(fieldList, sourceColumn) '' Just in case you merge a merged sheet
    sourceColumn = "SourceSheet" & c
    c = c + 1
  Loop
  mergedRS.Fields.Append sourceColumn, adVarChar, MAX_CHARS
  For Each f In fieldList
    mergedRS.Fields.Append CStr(f), adVarChar, MAX_CHARS
  Next
  mergedRS.Open

  c = 1
  For Each rs In rsetList
    If rs.RecordCount >= 1 Then
      rs.MoveFirst
      Do Until rs.EOF
        mergedRS.AddNew
        mergedRS.Fields(sourceColumn) = "Sheet No. " & c
        For Each f In rs.Fields
          mergedRS.Fields(f.Name) = f.Value
        Next
        rs.MoveNext
      Loop
    End If
    c = c + 1
  Next


  Set sh = wb.Worksheets.Add

  mergedRS.MoveFirst
  r = 1
  c = 1
  For Each f In mergedRS.Fields
    sh.Cells(r, c).Formula = f.Name
    c = c + 1
  Next

  r = 2
  Do Until mergedRS.EOF
    c = 1
    For Each f In mergedRS.Fields
      sh.Cells(r, c).Value = f.Value
      c = c + 1
    Next
    r = r + 1
    mergedRS.MoveNext
  Loop
End Sub

Public Function InCollection(col As Collection, key As String) As Boolean
  Dim var As Variant
  Dim errNumber As Long

  InCollection = False
  Set var = Nothing

  Err.Clear
  On Error Resume Next
    var = col.Item(key)
    errNumber = CLng(Err.Number)
  On Error GoTo 0

  '5 is not in, 0 and 438 represent incollection
  If errNumber = 5 Then ' it is 5 if not in collection
    InCollection = False
  Else
    InCollection = True
  End If

End Function


Public Function FindEndCell(sh As Worksheet) As String
  Dim cols As Long
  Dim rows As Long
  Dim maxCols As Long
  Dim maxRows As Long
  Dim c As Long
  Dim r As Long

  maxRows = sh.rows.Count
  maxCols = sh.Columns.Count

  cols = sh.Range("A1").End(xlToRight).Column
  If cols >= maxCols Then
      cols = 1
  End If


  c = 1
  Do While c <= cols

    r = sh.Cells(1, c).End(xlDown).Row
    If r >= maxRows Then
      r = 1
    End If

    If r > rows Then
      rows = r
    End If
    c = c + 1
  Loop

  FindEndCell = sh.Cells(rows, cols).Address

End Function

Answer 3

当我的一位客户来找我寻找解决方案来合并他们保存在200多个单独文件中的库存清单时，我遇到了这个问题。如果你发现自己和我的客户处于相同的位置;别担心，我写了一个简单的程序来做这项工作。 :)检查以下链接：

JMC Excel - Join, Merge, Combine multiple Excel sheets or Excel workbooks

此致 JeeShen Lee www.jeeshenlee.wordpress.com