Question

我是vba的新手，需要一些帮助，因为我无法解决这个问题

尝试将excel工作簿中的某个工作表中的某些特定内容保存到CSV文件时，我无法获得正确的输出格式。这是至关重要的，因为有些列需要文本限定符而其他列则不需要，因为文件将进入企业解决方案，所以我必须正确使用它。

我有5列A-E，它包含我需要输出的数据作为csv，A，C和A列; E需要文本限定符，但B＆amp; D不。

csv文件有2个标题行，没有任何＆＃34;限定符

我试图让这个工作，但有2个问题 1）A，C和A列; E需要引用，B＆amp; D不是引号 2）第1行中的标题在我要删除的末尾有额外的,,,

我正在使用的代码如下，我附上了一个示例文件的图像，以实现它。

该文件执行以下操作 1）选择列A-E中的动态行范围 2）使用数据和保存作为特定名称保存。时间包括它。

Sub SaveDynamicRangeAsCSVFile_IncTextDelimiters()

'Turn off screen updating for performance and prevent dizziness
     Application.ScreenUpdating = False

'Set-up
    Dim MyPath As String
    Dim MyFileName As String
    Dim WB1 As Workbook, WB2 As Workbook
    Set WB1 = ActiveWorkbook
    MyFileName = "ProdTabData-" & Format(Date, "yyyymmdd-") & Format(Time, "hhmmss")
    FullPath = WB1.Path & "\" & MyFileName

'Dynamic range identified
    Application.ScreenUpdating = False
    Range("A5:E" & Cells(Rows.Count, 1).End(xlUp).Row).Copy
    Set WB2 = Application.Workbooks.Add(1)
    WB2.Sheets(1).Range("A1").PasteSpecial xlPasteValues
    Application.DisplayAlerts = False

'save file
    If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"
    With WB2
        .SaveAs Filename:=FullPath, FileFormat:=xlCSV, CreateBackup:=False
        .Close False
    End With
    Application.DisplayAlerts = False

'Turn on screen updating
        Application.ScreenUpdating = True

End Sub

它给我的输出是：

导出文件名,,,,

列1，列2，栏3，Column4，Column5

名称1，组1，描述1,1,0

名称2，组2，描述2,1,0

名称3，组3，描述3,1,0

名称4，组4，描述4,1,0

名称5，组5，描述5,1,0

名称6，组6，描述6,1,0

名称7，组7，描述7,1,0

我需要它：

导出文件名

列1，列2，栏3，Column4，Column5

＆＃34;名称1＆＃34;，组1，＆＃34;描述1＆＃34;，1，＆＃34; 0＆＃34;

＆＃34;名称2＆＃34;，组2，＆＃34;描述2＆＃34;，1，＆＃34; 0＆＃34;

＆＃34;名称3＆＃34;，Group3，＆＃34;描述3＆＃34;，1，＆＃34; 0＆＃34;

＆＃34;名称4＆＃34;，Group4，＆＃34;说明4＆＃34;，1，＆＃34; 0＆＃34;

＆＃34;名称5＆＃34;，Group5，＆＃34;描述5＆＃34;，1，＆＃34; 0＆＃34;

＆＃34;名称6＆＃34;，Group6，＆＃34;描述6＆＃34;，1，＆＃34; 0＆＃34;

＆＃34;名称7＆＃34;，Group7，＆＃34;说明7＆＃34;，1，＆＃34; 0＆＃34;

我一直在不同的解决方案，所以需要一些专家指导。

欢迎所有建议变得绝望感谢

Excel file image

Answer 1

我想这样做

Sub SaveDynamicRangeAsCSVFile_IncTextDelimiters()
    Dim rngDB As Range
'Turn off screen updating for performance and prevent dizziness
     Application.ScreenUpdating = False

'Set-up
    Dim MyPath As String
    Dim MyFileName As String
    Dim WB1 As Workbook, WB2 As Workbook
    Set WB1 = ActiveWorkbook
    MyFileName = "ProdTabData-" & Format(Date, "yyyymmdd-") & Format(Time, "hhmmss")
    FullPath = WB1.Path & "\" & MyFileName

'Dynamic range identified
    Application.ScreenUpdating = False
    Set rngDB = Range("A5:E" & Cells(Rows.Count, 1).End(xlUp).Row)
    Application.DisplayAlerts = False

'save file
    If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"
    Application.DisplayAlerts = False
    TransToCSV MyFileName, rngDB
'Turn on screen updating
        Application.ScreenUpdating = True

End Sub
Sub TransToCSV(myfile As String, rng As Range)

    Dim vDB, vR() As String, vTxt()
    Dim i As Long, n As Long, j As Integer
    Dim objStream
    Dim strTxt As String

    Set objStream = CreateObject("ADODB.Stream")
    vDB = rng
    For i = 1 To UBound(vDB, 1)
        n = n + 1
        ReDim vR(1 To UBound(vDB, 2))
        For j = 1 To UBound(vDB, 2)
            Select Case j
            Case 1, 3, 5
                If i = 2 Then
                    vR(j) = vDB(i, j)
                Else
                    vR(j) = Chr(34) & vDB(i, j) & Chr(34)
                End If
            Case Else
                vR(j) = vDB(i, j)
            End Select
        Next j
        ReDim Preserve vTxt(1 To n)
        If i = 1 Then
            vTxt(n) = vDB(1, 1)
        Else
            vTxt(n) = Join(vR, ",")
        End If
    Next i
    strTxt = Join(vTxt, vbCrLf)
    With objStream
        '.Charset = "utf-8"
        .Open
        .WriteText strTxt
        .SaveToFile myfile, 2
        .Close
    End With
    Set objStream = Nothing

End Sub

excel vba导出csv文件引用限定符

1 个答案: