Question

我在一个工作簿中有几十个Excel工作表/标签，它是从图像分析包输出的，我想将它们全部合并到一个主表中。虽然蛮力复制和粘贴可行，但我将输出数百个以这种格式出现的数据，简化的方法将非常有用。
起始格式;工作簿中的第一个工作表可能看起来像这样：

X | Y | ž

12 | 5 | 9

14 | 8 | 12

13 | 5 | 11

表单2，它位于同一工作簿中，但在不同的选项卡下将是

A | B | ç

4 | 9 | 1

2 | 4 | 8

3 | 2 | 1

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

X | Y | Z | A | B | ç

12 | 5 | 9 | 4 | 9 | 1

14 | 8 | 12 | 2 | 4 | 8

13 | 5 | 11 | 3 | 2 | 1

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

如何合并带有不同标题的Excel工作表。

2 个答案: