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

Question

我在一个工作簿中有几十个excel工作表/选项卡，它是从图像分析包输出的，我想将它们合并到一个母版表中。虽然蛮力复制和粘贴将工作，我将输出数百条数据，将以这种格式和精简方法将是非常有益的。

开始格式；工作表之一的工作簿可能如下所示：

X-Y-重Z

12 -5-9

14 .8.12

13 -5-11

工作表2，它位于相同的工作簿中，但位于不同的选项卡下。

A/B/C

4-9-1

2-4-8

3-2-1

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

X

12 -5

14 -8-12

13 -5

Answer 1

只需引用要从其中复制数据的工作表。拖动十字头发，直到所需的位置。

='Sheet2'!A1

Answer 2

复制以下脚本并将其保存到Merge.vbs中。可以将excel文件拖放到此脚本文件之上以合并它们。第一个数据行必须包含列名。将跳过没有列名的列。脚本将在开始时创建一个新的“组合”工作表。如果下一个工作表将包含上一个工作表中未出现的列名，则将添加新列。

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