首页
学习
活动
专区
圈层
工具
发布
首页
学习
活动
专区
圈层
工具
社区首页 >问答首页 >有没有办法将范围批量写入文本/CSV文件?

有没有办法将范围批量写入文本/CSV文件?
EN

Stack Overflow用户
提问于 2012-10-26 05:08:38
回答 4查看 18K关注 0票数 3

我习惯于使用VBA中的write命令将一系列单元格的内容(值)写入文本文件,例如:

write #myfile, Range("A1").value, Range("A2).value, Range("A3).value

有没有一种更优雅、更方便的内置方法,可以将整个范围直接转储到分隔文件中,甚至可以一次转储到多行?或者,是否有人提出了定制的解决方案?我认为这将是非常有用的。

EN

回答 4

Stack Overflow用户

回答已采纳

发布于 2012-10-26 05:20:08

我给你写了这个,它仍然可以改进,但我认为它已经足够好了:

代码语言:javascript
代码运行次数:0
运行
复制
Sub SaveRangeAsCSV(r As Range, filename As String, overwrite As Boolean)
    Dim wB As Workbook
    Dim c As Range
    Dim usedRows As Long
    If overwrite Then
        If Dir(filename) <> "" Then Kill filename
        If Err.Number <> 0 Then
            MsgBox "Could not delete previously existing file." & vbNewLine & Err.Number & ": " & Err.Description
            Exit Sub
        End If
    End If
    If Dir(filename) <> "" Then
        Set wB = Workbooks.Open(filename)
    Else
        Set wB = Workbooks.Add
    End If

    With wB.Sheets(1)
        usedRows = .UsedRange.Rows.Count
        'Check if more than 1 row is in the used range.
        If usedRows = 1 Then
            'Since there's only 1 row, see if there's more than 1 cell.
            If .UsedRange.Cells.Count = 1 Then
                'Since there's only 1 cell, check the contents
                If .Cells(1, 1) = "" Then
                      'you're dealing with a blank workbook
                      usedRows = 0
                End If
            End If
        End If
        'Check if range is contigious
        If InStr(r.Address, ",") Then
            For Each c In r.Cells
                .Range(c.Address).Offset(usedRows, 0).Value = c.Value
            Next
        Else
            .Range(r.Address).Offset(usedRows, 0).Value = r.Value
        End If
    End With
    wB.SaveAs filename, xlCSV, , , , False
    wB.Saved = True
    wB.Close
End Sub
Sub Example()
    'I used Selection here just to make it easier to test.
    'Substitute your actual range, and actual desired filepath
    'If you pass false for overwrite, it assumes you want to append
    'It will give you a pop-up asking if you want to overwrite, which I could avoid
    'by copying the worksheet and then closing and deleting the file etc... but I
    'already spent enough time on this one.
    SaveRangeAsCSV Selection, "C:\proofOfConcept.csv", False
End Sub

在使用它时,只需提供实际范围、实际文件名以及是否要覆盖该文件。:)已更新为允许非连续范围。对于合并的单元格,它将最终将值放入合并区域的第一个单元格中。

票数 4
EN

Stack Overflow用户

发布于 2012-10-26 06:01:25

这是我自己想出来的解决方案,在我看来最适合我的需求:

代码语言:javascript
代码运行次数:0
运行
复制
Sub DumpRangeToTextFile(filehandle As Integer, source As Range)
Dim row_range As Range, mycell As Range
For Each row_range In source.rows
    For Each mycell In row_range.cells
        Write #filehandle, mycell.Value;
    Next mycell
    Write #filehandle,
Next row_range
End Sub

短小精悍!;)

尽管如此,我还是给了丹尼尔·库克的解决方案,它也是非常有用的,值得称赞。

票数 2
EN

Stack Overflow用户

发布于 2016-02-29 06:29:00

上面的这些方法遍历单元格区域,以便导出数据。由于所有的错误检查,任何倾向于循环遍历工作表中的单元格范围的操作都会非常慢。

这是我在没有迭代的情况下完成的一种方法。基本上,它使用内置的函数"Join()“来做繁重的工作,这将是您的迭代循环。这要快得多。

我在另一篇文章中详细介绍了相关的Read()子例程:https://stackoverflow.com/a/35688988/2800701

这是Write()子例程(注意:此例程假定您的文本在导出之前已预先格式化为工作表中的正确规范;它仅适用于多个列范围的单个column...not ):

代码语言:javascript
代码运行次数:0
运行
复制
Public Sub WriteRangeAsPlainText(ExportRange As Range, Optional textfilename As Variant)
   If IsMissing(textfilename) Then textfilename = Application.GetSaveAsFilename(FileFilter:="Text Files (*.txt), *.txt")
   If textfilename = "" Then Exit Sub

   Dim filenumber As Integer
   filenumber = FreeFile
   Open textfilename For Output As filenumber

   Dim textlines() As Variant, outputvar As Variant

   textlines = Application.Transpose(ExportRange.Value)
   outputvar = Join(textlines, vbCrLf)
   Print #filenumber, outputvar
   Close filenumber
End Sub
票数 1
EN
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接:

https://stackoverflow.com/questions/13077317

复制
相关文章

相似问题

领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档