Question

我有一张包含大量数据的Excel表格。数据组织如下，一组7列和n行;如表中所示，1000个这样的表水平放置，空列分开。截图位于下方..

enter image description here ...

我只想将每个'表'的数据保存到不同的文件中。手动它需要永远！那么，是否有一个宏或其他什么我会自动执行此任务。我不熟悉编写宏或任何VBA的东西。

谢谢，

Answer 1

Tony说出

时有一个有效的观点

如果从C1开始的表在第21行结束，下一个表是否从C23开始？如果从K1开始的表在第15行结束，那么下一个表是从K17还是K23开始的？

所以这里的代码可以在任何条件下工作，即数据是水平或垂直设置的。

DATA SNAPSHOT

enter image description here

<强> CODE

'~~> 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：$ Y $ 33，......“。如果您在互联网上搜索，您会发现网站告诉您Rng.Address的最大长度为253个字符。我不相信这是正确的。根据我的经验，Rng.Address在完整的子范围内被截断。我的实验是使用Excel 2003，但我发现在互联网上注意到这一限制已在更高版本的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.工作表TableSpec现在提供生成文件所需的所有信息。您可以删除大部分内容并在几行上测试文件创建代码。

如果你的VBA很弱，我希望你能看到这种分步方法的优点。祝你好运。

将数据从Excel工作表复制到不同的文件

3 个答案: