☰

將多張表中的表格合併為一張表

tag-icon • tag-icon microsoft-excel microsoft-excel-2007
將多張表中的表格合併為一張表

我有一個 30 多張的 Excel 文件。每個都有相同的佈局：一個簡單的表格，具有相同的列、標題/總行數，但行數不同（沒有一個表格的行數超過 500 行）。

我想將它們組合成一個主表。僅限一次操作。

我可以手動將 30 個表一個接一個地複製到一張新工作表上。完成後，我會進行排序並刪除任何空白/標題/總行。我不關心格式。我猜這大約需要 15-20 分鐘，但我總是有犯錯、漏掉一張紙或其他東西的風險。

VBA 聽起來需要太多時間。現在我幾乎正在考慮將工作簿匯入 SQL Server，將它們合併並將結果複製並貼上回 Excel。

你有什麼好的技巧嗎？

答案1

如果這是您需要經常執行的操作，那麼我建議您編寫一個快速 VBA 例程。如果這是一次性的事情，那麼我會手動完成。為確保您不會意外跳過表格，請使用剪下貼上而不是複製貼上。

我將這樣做。使用鍵盤快速鍵，速度相當快。

  • 在 Excel 中以唯讀方式開啟原始工作簿，以防止意外遺失資料。
  • 開啟一個新工作簿來儲存新的主表。
  • 關閉所有其他工作簿，以便在您正在使用的兩個工作簿之間輕鬆切換。
  • 選擇原始工作簿中要複製的第一個工作表。

現在您可以開始使用鍵盤快速鍵。

  1. Ctrl + Home跳到電子表格的左上角。 （這將跳到 A1，除非有凍結的行或列。）
  2. Shift + Ctrl + End選擇目前選取儲存格左側和下方的所有內容。
  3. Ctrl + X來剪切資料。
  4. Ctrl + Tab切換到新工作簿。
  5. 仔細檢查您是否位於正確的位置，然後按Enter貼上資料。
  6. Ctrl + End轉到貼上的最後一個單元格。
  7. Down Arrow轉到下一個未使用的行。
  8. Ctrl + Left Arrow返回 A 列。
  9. Ctrl + Tab切換回原始工作簿。
  10. Ctrl + Page Down選擇下一個工作表。
  11. 返回步驟 1 並重複直至完成。

完成後，您可以Ctrl + Page Up返回所有原始工作表並驗證所有資料是否已刪除。

假設您的標題行未凍結，這將從所有 30 個表中複製標題行。在這種情況下，要么對主表進行排序以對所有重複的標題行進行分組並刪除多餘的內容，要么使用資料 -> 刪除重複項。

如果您不小心跳過了某個步驟或貼上了現有數據，請Ctrl + Z按 撤銷。

我剛剛按照上述步驟做了一個測試。我使用的工作簿有 10 個工作表，每個工作表有 120 行資料。我花了 1.5 分鐘創建主表。如果您不熟悉鍵盤快捷鍵，可能會花費兩倍的時間。對於 30 張工作表，我猜您可能需要 10 分鐘。

答案2

我添加了同樣的問題，在這裡找到了一個很棒的巨集： http://excel.tips.net/T003005_Condensing_Multiple_Worksheets_Into_One.html

Sub Combine()
    Dim J As Integer

    On Error Resume Next
    Sheets(1).Select
    Worksheets.Add ' add a sheet in first place
    Sheets(1).Name = "Combined"

    ' copy headings
    Sheets(2).Activate
    Range("A1").EntireRow.Select
    Selection.Copy Destination:=Sheets(1).Range("A1")

    ' work through sheets
    For J = 2 To Sheets.Count ' from sheet 2 to last sheet
        Sheets(J).Activate ' make the sheet active
        Range("A1").Select
        Selection.CurrentRegion.Select ' select all cells in this sheets

        ' select all lines except title
        Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select

        ' copy cells selected in the new sheet on last line
        Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
    Next
End Sub

只需複製貼上宏，運行它就完成了！

相關內容