如何合并 excel 个标题不同的工作表。

How to merge excel sheets with dissimilar headings.

我在一个工作簿中有几十个 excel sheets/tabs 是从图像分析包输出的,我想将它们全部合并到一个主文件中 sheet。虽然暴力复制和粘贴会起作用,但我将输出数百条数据,这些数据将以这种格式出现,简化的方法将非常有益。
起始格式; sheet 其中一个工作簿可能如下所示:

X |是 | Z

12 |5 | 9

14 |8 |12

13 |5 |11

sheet 两个,在同一个工作簿中但在不同的选项卡下将是

一个 |乙 | C

4 | 9 | 1

2 | 4 | 8

3 | 2 | 1

我想要的是将 sheets 合并到一个工作簿/一个具有相同行数的选项卡中,并将新值放在与原始值相邻的一组新列中一个(每个 sheet 具有相同的行数,因为数据只是关于相同项目的不同方面)

X |是 | Z |一个 |乙 | C

12 |5 | 9 | 4 | 9 | 1

14 |8|12 | 2 | 4 | 8

13 | 5 | 11 | 3 | 2| 1

只需引用要从中复制数据的工作表。拖动十字准线至所需位置。

='Sheet2'!A1

复制以下脚本并将其保存到Merge.vbs。您可以将 excel 个文件拖放到此脚本文件之上以合并它们。第一个数据行必须包含列名。将跳过没有列名的列。该脚本将在开头创建一个新的 "Combined" sheet。如果下一个作品sheet 将包含前一个sheet 中不存在的列名称,将添加一个新列。

if WScript.Arguments.Count = 0 then
    MsgBox "Please drag and drop an excel file on top of this script file to merge sheets."
    WScript.Quit
End If

Set fso = CreateObject("Scripting.FileSystemObject")
sFilePath = WScript.Arguments(0)

If fso.FileExists(sFilePath) = False Then
  MsgBox "Could not file Excel file: " & sFilePath & " to merge sheets"
  WScript.Quit
End If

If MsgBox("Merge worksheets for this file: " & sFilePath, vbYesNo + vbQuestion) = vbNo Then
  WScript.Quit
End If

Dim dic: Set dic = CreateObject("Scripting.Dictionary")
Dim oExcel: Set oExcel = CreateObject("Excel.Application")
oExcel.Visible = True
oExcel.DisplayAlerts = false
Set oWorkBook = oExcel.Workbooks.Open(sFilePath)

Set oCombined = oWorkBook.Worksheets.Add(oWorkBook.Worksheets(1))
oCombined.Name = "Combined"
dic("Sheet Name") = 1
oCombined.Cells(1, 1).Value = "Sheet Name"
oCombined.Cells(1, 1).EntireRow.Font.Bold = True
iRowOffset = 0

For Each oSheet in oWorkBook.Worksheets
    If oSheet.Name <> "Combined" Then
        iRowsCount = GetLastRowWithData(oSheet)

        For iRow = 1 to iRowsCount
            If iRow = 1 And iRowOffset = 0 Then
                'Sheet Name header
            Else
                oCombined.Cells(iRow + iRowOffset, 1).Value = oSheet.Name
            End If
        Next

        For iCol = 1 to oSheet.UsedRange.Columns.Count
            sCol = trim(oSheet.Cells(1, iCol).Value & "")

            If sCol <> "" Then 'Skip columns with no data

                If dic.Exists(sCol) Then
                    iDestCol = dic(sCol)
                Else
                    iDestCol = dic.Count + 1
                    dic(sCol) = iDestCol
                    oCombined.Cells(1, iDestCol).Value = sCol
                End If

                For iRow = 2 to iRowsCount
                    oCombined.Cells(iRow + iRowOffset, iDestCol).Value = oSheet.Cells(iRow, iCol).Value
                Next
            End If
        Next

        iRowOffset = iRowOffset + iRowsCount - 1
    End If
Next

MsgBox "Done!"

Function GetLastRowWithData(oSheet)
    iMaxRow = oSheet.UsedRange.Rows.Count
    If iMaxRow > 500 Then
        iMaxRow = oSheet.Cells.Find("*", oSheet.Cells(1, 1),  -4163, , 1, 2).Row
    End If

    For iRow = iMaxRow to 1 Step -1
         For iCol = 1 to oSheet.UsedRange.Columns.Count
            If Trim(oSheet.Cells(iRow, iCol).Value) <> "" Then
                GetLastRowWithData = iRow
                Exit Function
            End If
         Next
    Next
    GetLastRowWithData = 1
End Function

Function GetLastCol(st)
    GetLastCol = st.Cells.Find("*", st.Cells(1, 1), , 2, 2, 2, False).Column
End Function