时间戳

首页 > 解决方案 > 如何有效地为工作表中的每一列创建 csv 文件？

excel - 如何有效地为工作表中的每一列创建 csv 文件？

问题描述

我有一个包含许多列的工作表（在我的情况下为 82 列），我希望为每一列创建一个 csv 文件。感谢本网站上许多问题/答案的帮助，我设法用下面的代码做到了。运行代码会在 Windows 任务栏上执行一些我以前从未见过的操作（文件的创建和关闭），但我觉得有一种更有效、更快的方法。有什么建议么？

' Create a separate csv file for each column.
Sub ColumnsToCSV()
Dim i As Byte
Dim cols As Byte                                                        ' column count
Dim name As String                                                      ' 01, 02, .., 99
cols = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column    ' count columns

For i = 1 To cols                                                       ' loop columns
   name = Format(i, "00")                                               ' 1 => 01, etc.
   Sheets.Add(After:=Sheets(Sheets.Count)).name = name                  ' add sheet
   Sheets("Data").Columns(i).Copy Destination:=Sheets(name).Columns(1)  ' copy data
   ThisWorkbook.Sheets(name).Copy                                       ' create copy
   ActiveWorkbook.SaveAs Filename:=name, FileFormat:=xlCSV              ' save to csv
   ActiveWorkbook.Close                                                 ' close csv
   Application.DisplayAlerts = False                                    ' disable alerts
   ActiveSheet.Delete                                                   ' delete sheet
   Application.DisplayAlerts = True                                     ' enable alerts
Next i
End Sub

标签： excelvbacsv

解决方案

试试这个：

' Create a separate csv file for each column.
Sub ColumnsToCSV()
                                                          
    Dim name As String, pth As String, cols As Long, i As Long
    Dim rng As Range, data, ws As Worksheet, r As Long, v
    
    Set ws = ActiveSheet
    cols = ws.UsedRange.SpecialCells(xlCellTypeLastCell).Column
    pth = ThisWorkbook.Path & "\"      'or whereever you want to save....
    
    For i = 1 To cols
        data = AsArray(ws.Range(ws.Cells(1, i), ws.Cells(Rows.Count, i).End(xlUp)))
        For r = 1 To UBound(data, 1)
            v = data(r, 1)
            If InStr(v, ",") > 0 Then data(r, 1) = """" & v & """" 'quote commas
        Next r
        'write the output (note Tanspose() has a limit of approx 63k items)
        PutContent pth & Format(i, "00") & ".csv", _
                   Join(Application.Transpose(data), vbCrLf)
    Next i
End Sub

'write text to a file
Sub PutContent(f As String, content As String)
    CreateObject("scripting.filesystemobject"). _
                  opentextfile(f, 2, True).write content
End Sub
'return range value as array (handle case where range is a single cell)
Function AsArray(rng As Range)
    Dim rv()
    If rng.Cells.Count = 1 Then
        ReDim rv(1 To 1, 1 To 1)
        rv(1, 1) = rng.Value
        AsArray = rv          'edit: this was missing...
    Else
        AsArray = rng.Value
    End If
End Function

推荐阅读