使用VBA合并Excel工作表

Question

我有一个Excel表格(比如OG.xls)，其中已经有一些数据，其中有大约5000行，第一行有标题，最多有"AN“列。行数(5000)在一整年内都不会改变。现在我有5个XL文件(比如A、B、C、D、E)，这些文件中的数据每次都必须从第500行开始添加到这个OG文件中。这5个文件的列数不同，但与OG文件的列数相同。我必须从这些文件中提取数据，并将其放入OG文件中。从文件A :A、B、C、D、E、F、G和H列转到OG.xls文件的F、G、T、U、V、W、X和Y列。同样，其他文件数据也必须根据OG.xls对应的列进行提取

第二个文件数据必须追加到文件A结束的下一行的正下方。(例如，在填充文件A的数据之后，现在OG.xls有5110行，文件B的数据必须从OG.xls的第5111行开始填充。其他文件也是如此。这5个文件的数据必须逐行填充，但应将列与OG.xls的列匹配

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

我们怎么能做到这一点。

请在这方面帮助我！如果有任何澄清，也请让我知道。

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