☰

根据列快速将数据导出到不同的 Excel 文件中

tag-icon • tag-icon microsoft-excel microsoft-excel-2010 microsoft-excel-2013 csv
根据列快速将数据导出到不同的 Excel 文件中

有一些这样的数据（超过 500,000 条）

Name    |    State
----         -----
Billy        Utah
Sue          California
Joe          Utah
Sally        California
John         Michigan

我想要做的是将每个州的数据导出到一个新的电子表格中（这样它会创建类似的文件California.csv等等Utah.csv）。

有没有一种快速自动化的方法来做这样的事情？

答案1

假设 A 列为“名称”，B 列为“州”：

在 C 列中，使用公式="echo """&A1&""" >>"&B1&".csv"。

这会将每一行附加（因此>>）到文件 (state).csv。

将 C 列的内容复制到剪贴板并粘贴到命令提示符窗口（记住先复制cd到正确的目录）。

（注意 - 未经测试 - 首先检查结果是否合理。）

答案2

这是拼凑起来的，但对我来说很有用。如果需要，请更改目的地和“州”标题。如果您的工作表比两列更复杂，您还可以更改过滤器。

Option Explicit

Sub CreateCSVfromWS()
Dim ws As Worksheet
    Application.ScreenUpdating = False

    Call Filter
    Call MakeMonthSheets

        For Each ws In ActiveWorkbook.Worksheets
            ws.SaveAs "C:\Destination\" & ws.Name & ".csv", xlCSV
        Next

    Application.ScreenUpdating = True
End Sub

Sub Filter()
Columns("A:B").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _
        ("B:B"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Sub MakeMonthSheets()

    Dim rngState As Range
    Dim rngCell As Range
    Dim sh As Worksheet
    Dim shDest As Worksheet
    Dim rngNext As Range

    Const sLNHEADER As String = "State"

    Set sh = ThisWorkbook.Sheets("Sheet1")
    Set rngState = sh.UsedRange.Find(sLNHEADER, , xlValues, xlWhole)

    'Make sure you found something
    If Not rngState Is Nothing Then
        'Go through each cell in the column
        For Each rngCell In Intersect(rngState.EntireColumn, sh.UsedRange).Cells
            'skip the header and empty cells
            If Not IsEmpty(rngCell.Value) And rngCell.Address <> rngState.Address Then
                'see if a sheet already exists
                On Error Resume Next
                    Set shDest = sh.Parent.Sheets(rngCell.Value)
                On Error GoTo 0

                'if it doesn't exist, make it
                If shDest Is Nothing Then
                    Set shDest = sh.Parent.Worksheets.Add
                    shDest.Name = rngCell.Value
                End If

                'Find the next available row
                Set rngNext = shDest.Cells(shDest.Rows.Count, 1).End(xlUp).Offset(1, 0)

                'Copy and paste
                Intersect(rngCell.EntireRow, sh.UsedRange).Copy rngNext

                'reset the destination sheet
                Set shDest = Nothing
            End If
        Next rngCell
    End If

End Sub

答案3

这是一个简单但有点繁琐的方法。设置起来很繁琐，但执行起来很简单。有一些简单的更改不会相当与问题相符（但很接近）并且更容易做。

  1. 将主工作簿设置为问题中的示例
  2. 为第一个州（您想要不同的文件）设置一个工作簿，在 A1 中输入该州的名称，在 A2 中输入一个简单的条件 =IF([master.xlsx]Sheet1!$B2=$A$1,[master.xlsx]Sheet1!$A2,"")，然后复制名称列表的长度。请注意，该行不是绝对的，因此您将在 A1 中获得空白和州的名称。
  3. 设置一个宏，将选项卡 1 的值复制到选项卡 2 并进行排序，这样空白就会从末尾消失。
  4. 复制第一个州的工作簿以形成其余州；更改州名称

为每个州设置一个选项卡并在一个工作簿中执行会更简单；您可以为每个州命名选项卡，并在条件公式中使用选项卡名称。可能有一种方法可以使用数组公式一步完成此操作，但我现在不记得怎么做了。

相关内容