VBA 读取sheet页中的指定区域数据，生成CSV文件

fengyehongWorld

于 2024-05-03 16:54:12 发布

阅读量497

点赞数 2

分类专栏： # VBA 文章标签： VBA

本文链接：https://blog.csdn.net/feyehong/article/details/138418198

版权

VBA 专栏收录该内容

8 篇文章 0 订阅

订阅专栏

⏹待生成数据的sheet页

在这里插入图片描述

⏹VBA代码

CreateObject("ADODB.Stream")：Microsoft ActiveX Data Objects (ADO) 库中的一个对象，用来处理文件的读写操作。
Application.PathSeparator：系统默认的分隔符。
Const startRowNum = 4：定义一个常量
.SaveToFile FileName, SaveOptions
- adSaveCreateNotExist(0)：如果文件不存在，则创建文件并保存数据。
- adSaveCreateOverWrite(2)：如果文件存在，则覆盖现有文件并保存数据。
- adSaveCreateNotExist(1)：如果文件存在，则追加数据到文件末尾。
- adSaveCreateOverWrite(4)：如果文件存在，则在当前文件后面继续写入数据。
换行符
- vbCrLf：windows的换行符 \r\n
- vbLf：Linux系统换行符 \n

Sub Csv_create()

    Dim fso As Object
    Dim lineInfo As String
    Dim i As Long
    
    ' ADODB.Stream 是 Microsoft ActiveX Data Objects (ADO) 库中的一个对象，用来处理文件的读写操作。
    Set fso = CreateObject("ADODB.Stream")
    ' 获取要生成的文件的名称, Application.PathSeparator 表示系统默认的分隔符
    Dim fileName As String: fileName = ThisWorkbook.Path & Application.PathSeparator & Sheets("SHOP_INFO").Cells(1, 1).Value & ".csv"
    
    ' 打开处理文件的流对象
    With fso
        .Charset = "UTF-8"
        ' -1表示: 使用系统默认的分隔符
        .LineSeparator = -1
        .Open
    End With
    
    ' 定义一个常量,标识如果文件存在,则覆盖现有文件并保存数据。
    Const adSaveCreateOverWrite = 2
    ' 开始的行号
    Const startRowNum = 4
    
    ' 从"SHOP_INFO"工作表的 B2单元格 开始向下的连续非空单元格范围的最后一行
    ' 定义变量的同时,给变量赋值
    Dim endRowNum As Integer: endRowNum = Sheets("SHOP_INFO").Cells(2, 2).End(xlDown).Row
    
    With Sheets("SHOP_INFO").UsedRange
    
        For i = startRowNum To endRowNum
        
            lineInfo = ""
            lineInfo = lineInfo & """" & Sheets("SHOP_INFO").Cells(i, 2).Value & """" & ","
            lineInfo = lineInfo & """" & Sheets("SHOP_INFO").Cells(i, 3).Value & """" & ","
            lineInfo = lineInfo & """" & Sheets("SHOP_INFO").Cells(i, 4).Value & """" & ","
            lineInfo = lineInfo & """" & Sheets("SHOP_INFO").Cells(i, 5).Value & """" & ","
            lineInfo = lineInfo & """" & Sheets("SHOP_INFO").Cells(i, 6).Value & """"
            
            ' vbCrLf: windows的换行符 \r\n
            ' vbLf: Linux系统换行符 \n
            fso.WriteText lineInfo & vbLf
            
        Next
    End With
    
    ' 保存文件
    fso.SaveToFile fileName, adSaveCreateOverWrite
    fso.Close
    
    Set fso = Nothing
    
    MsgBox "csv文件创建完成!"

End Sub