將數據從 Excel 工作表復制到不同的文件

Question

我有一個 excel 表，里面有一些巨大的數據。 數據組織如下，一組7列n行； 就像在一張桌子中一樣，將 1000 張這樣的桌子水平放置，並用空列分隔。 截圖如下..

...

我只想將每個“表”的數據保存到不同的文件中。 手動它需要永遠！ 那么，是否有宏或我可以自動執行此任務的東西。 我不精通編寫宏或任何 VBA 的東西。

謝謝，

Answer 1

托尼說的有道理

如果從 C1 開始的表在第 21 行結束，下一個表是否從 C23 開始？ 如果從 K1 開始的表在第 15 行結束，下一個表是從 K17 還是 K23 開始？

所以這是一個可以在任何條件下工作的代碼，即水平或垂直設置數據。

數據快照

代碼

'~~> Change this to the relevant Output folder
Const FilePath As String = "C:\Temp\"

Dim FileNumb As Long

Sub Sample()
    Dim Rng As Range
    Dim AddrToCopy() As String
    Dim i As Long

    On Error GoTo Whoa

    Application.ScreenUpdating = False

    Set Rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants, xlTextValues)

    If Not Rng Is Nothing Then
        AddrToCopy = Split(Rng.Address, ",")

        FileNumb = 1

        For i = LBound(AddrToCopy) To UBound(AddrToCopy)
            ExportToSheet (AddrToCopy(i))
        Next i
    End If

    MsgBox "Export Done Successfully"

LetsContinue:
    Application.ScreenUpdating = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

Sub ExportToSheet(rngAddr As String)
    Range(rngAddr).Copy

    Workbooks.Add
    ActiveSheet.Paste

    ActiveWorkbook.SaveAs Filename:= _
    FilePath & "Output" & FileNumb & ".csv" _
    , FileFormat:=xlCSV, CreateBackup:=False

    Application.DisplayAlerts = False
    ActiveWorkbook.Close
    Application.DisplayAlerts = True

    FileNumb = FileNumb + 1
End Sub

注意：上面的代碼適用於只有文本值的單元格。 對於只有數值的單元格，您必須使用

Set Rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants, xlNumbers)

對於AlphaNumeric 值（如上面的問題），請使用此

Set Rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants)

HTH

錫德

Answer 2

只要任何數據集周圍都有空行和空列，這將使用 AREAS() 方法將它們全部放在單獨的工作簿中。

根據前面的示例，它保存為 CSV，但當然您可以根據需要保存它。

Option Explicit

Sub ExportDataGroups()
Dim fPATH As String, Grp As Long, DataRNG As Range

fPATH = "C:\Path\Where\I\Want\My\Files\Saved\"    'remember the final \
Application.ScreenUpdating = False

Set DataRNG = ActiveSheet.UsedRange

    For Grp = 1 To DataRNG.Areas.Count
        DataRNG.Areas(Grp).Copy
        Sheets.Add
        Range("A1").PasteSpecial
        ActiveSheet.Move

        ActiveWorkbook.SaveAs Filename:=fPATH & "-" & Format(Grp, "0000") & ".csv", _
            FileFormat:=xlCSV, CreateBackup:=False
        ActiveWorkbook.Close
    Next Grp

MsgBox "A total of " & Grp & " files were created"
Application.ScreenUpdating = True

End Sub

Answer 3

在你對我的評論的回應中，你說：“文件名，我從來沒有想過。現在可以是任何東西。” 根據慘痛的經驗，我可以告訴您，使用系統生成的名稱處理數千個文件是一場噩夢。 您現在需要解決名稱問題。

我也對AddrToCopy = Split(Rng.Address, ",")感到緊張。 Rng.Address的格式為：“$C$1:$I$16、$K$1:$Q$16、$S$1:$Y$16、$C18$I$33、$K$18:$Q$33、$S 18 美元：33 美元，……”。 如果您在 Internet 上搜索，您會發現一些網站告訴您Rng.Address的最大長度為 253 個字符。 我不相信這是正確的。 根據我的經驗， Rng.Address在完整的子范圍內被截斷。 我的實驗是在 Excel 2003 上進行的，但我發現在 Internet 上的注釋表明此限制已在更高版本的 Excel 中得到修復。 您需要使用您的 Excel 版本檢查Rng.Address ！ 我不熟悉 Jerry Beaucaire，盡管他提供了一個有趣的解決方案。 Sid Rout 總是能產生優秀的代碼。 如果有問題，我相信他們能夠解決它。

然而，這個“答案”的真正目的是說我會把這個問題分成三個。 這有很多優點，沒有我所知道的缺點。

步驟 1. 創建一個包含以下列的新工作表TableSpec ：

A      Worksheet name. (If tables are spread over more than worksheet) 
B      Range. For example: C1:I16, K1:Q16
C - I  Headings from table. For example, AAPL, Open, High, Low, Close, Volume, AdjClose 

步驟 2. 檢查工作表TableSpec ； 例如，是否列出了所有表？ 考慮文件名並添加 H 列以包含它。 我讀了您的一個評論，意思是您將“AAPL”作為第一個表的文件名，在這種情況下，您可以將 H2 設置為“=C2”。 “AAPL”是獨一無二的嗎？ 你可以有一個序列號。 在生成任何文件之前，您可以考慮很多選擇。

步驟 3. Worksheet TableSpec現在提供了生成文件所需的所有信息。 您可以刪除大部分內容並在幾行上測試文件創建代碼。

我希望您能看到這種階梯式方法的優點，尤其是在您的 VBA 較弱的情況下。 祝你好運。