Question

我想将简单的excel文件转换为CSV（管道分隔）使用excel vba 我尝试了很多代码，但无法获得预期的输出

following code I tried

      Sub mergeFiles()
        Dim xlwkbInput1  As Workbook
        Dim xlshtInput1  As Worksheet
        Dim xlwbfinalrpt As Workbook
        Dim xlshtfinalrpt As Worksheet

        Dim rcount1 As Long

        Dim xlwkbInput2  As Workbook
        Dim xlshtInput2 As Worksheet
        Dim xlapp As Excel.Application


        Set xlapp = New Excel.Application
        xlapp.Visible = True               

           Set xlwkbInput1 = xlapp.Workbooks.Open(ActiveWorkbook.Path & "\Output\Operative_CashFlow_Report.xlsx")
           Set xlwkbInput2 = xlapp.Workbooks.Open(ActiveWorkbook.Path & "\Output\Collection_CashFlow_Report.xlsx")

           xlwkbInput2.Sheets("Sheet1").Activate
           xlwkbInput2.ActiveSheet.UsedRange.Copy

           xlwkbInput1.Sheets("Sheet1").Activate
           rcount = xlwkbInput1.ActiveSheet.UsedRange.Rows.Count

           xlwkbInput1.Sheets("Sheet1").Range("A" & CStr(rcount + 1)).PasteSpecial

           xlwkbInput1.UsedRange("$A$1:$I$274").AutoFilter Field:=1, Criteria1:=Array( _
           "LIC106", "LIC107", "LIC134", "LIC138", "="), Operator:=xlFilterValues
           xlwkbInput1.UsedRange.Delete             
           xlwkbInput1.SaveAs ActiveWorkbook.Path & "\Output\final_report.xlsx"              
           Set xlwbfinalrpt = xlapp.Workbooks.Open(ActiveWorkbook.Path & "\Output\final_report.xlsx")       
           xlwbfinalrpt.Sheet("Sheet1").Activate

            xlwbfinalrpt.SaveAs ActiveWorkbook.Path & "\Output\final_report.xlsx"      

    xlwbfinalrptwb = Workbooks.Open (ActiveWorkbook.Path & "\Output\final_report.xlsx" 

         xlwbfinalrptwb .SaveAs fileName:=ActiveWorkbook.Path & "\Output\final_report.xlsx"
    , FileFormat:=xlCSV, CreateBackup:=False

＆＃39;这里我正在将excel转换为CSV文件

End Sub

Answer 1

您可以将Excel文件另存为逗号分隔或制表符分隔，但不能以管道分隔。

以下是如何实现管道分隔导出。

基本样本

只是为了显示基本面。

Sub Writing_to_a_text_file()
    Dim N As Integer
    Dim FileName As String

    'Define where to save the output file.
    FileName = Environ("USERPROFILE") & "\Desktop\" & "Sample1.csv" 

    'Get a free file number
    N = FreeFile

    Open FileName For Output As #N
        '"Print" print data into the file. Another method is "Write". 
        'Both do the same job but behave slightly differently. Try Google it.
        Print #N, "This is a test" 
        Print #N, "Writing another line here" 
        Print #N, Join(Array("Pipe", "delimited", "line", "here"), "|") 
        Print #N, vbNullString '<- this create an empty line
    Close N
End Sub

以管道分隔格式将一系列数据导出到文本文件

Sub ExportToTextFile()
'Export range("A1:E10") data to a text file in pipe delimited format.
    Dim N As Integer
    Dim FileName As String
    Dim R As Long, C As Long, DataLine As String

    FileName = Environ("USERPROFILE") & "\Desktop\" & "TextOutput.csv" 

    N = FreeFile

    Open FileName For Output As #N
        For R = 1 To 10
            DataLine = vbNullString
            For C = 1 To 5
                DataLine = DataLine & "|" & Cells(R, C).Value2
            Next C
            DataLine = Right(DataLine, Len(DataLine) - 1)
            Print #N, DataLine
        Next R
    Close N
End Sub

Answer 2

如果您只想将工作表另存为管道分隔文件，那么这应该适合您：

Sub DelimFile()

Open "C:\output.txt" For Output As 1 'Change this path

rowno = 1
colcount = Application.CountA(ActiveSheet.Rows(1))
While activesheet.Cells(rowno, 1) <> ""
    dataout = ""
    For c = 1 To colcount
        If c <> colcount Then
            dataout = dataout & """" & Trim(activesheet.Cells(rowno, c)) & """|"
        Else
            dataout = dataout & """" & Trim(activesheet.Cells(rowno, c)) & """"
        End If
    Next c
    Print #1, dataout
    rowno = rowno + 1
Wend
Close #1
End Sub

如何使用excel vba将excel文件转换为CSV文件（管道分隔）

2 个答案: