VBA使用特定列格式将CSV文件保存到Excel

时间:2016-02-25 19:08:13

标签: excel vba excel-vba

我很确定这是一个简单的请求,但我一般不会使用任何VBA脚本,所以我不知道。

我有一个约700个.csv文件的文件夹是“|”分隔,基本上我想要做的就是打开这个特定的文件夹并将所有.csv文件转换为.xls并将所有列格式化为“text”而不是“general”。我做了一些搜索,找到了转换文件的确切代码,但我无法弄清楚如何使列文本。任何帮助将不胜感激!我试过看,但如果答案是其他地方,请指出我正确的方向。 (以下是适用于.csv到.xls的代码)

Sub CSVtoXls()
Dim CSVfolder As String
Dim XlsFolder As String
Dim fname As String
Dim wBook As Workbook 
CSVfolder = "C:\Users\del44\Desktop\CSV Files\"
XlsFolder = "C:\Users\del44\Desktop\Excel Files\" 
fname = Dir(CSVfolder & "*.csv") 
Do While fname <> ""
Set wBook = Workbooks.Open(CSVfolder & fname, Format:=6, Delimiter:="|")
wBook.SaveAs XlsFolder & Replace(fname, ".csv", ".xls")
wBook.Close False
fname = Dir
Loop
Dim rCell As Range   

2 个答案:

答案 0 :(得分:1)

CSV转换可能是一个痛苦的屁股!

但是,我已经使用一个看起来很简单的CSV文件测试了您的情况

Scott|00001234|test
Mark|10101010|test
Brian|01010201|test

以下代码对我有用。 (我在书中结束了原始代码中关于插入代码格式化单元格的位置的行。)

Set wBook = Workbooks.Open(CSVfolder & fname, Format:=6, Delimiter:="|")

wBook.Sheets(1).Columns(1).TextToColumns _
        Destination:=Range("A1"), _
        DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, _
        Tab:=False, _
        Semicolon:=False, _
        Comma:=False, _
        Space:=False, _
        Other:=True, _
        OtherChar:="|", _
        '*** this is the key! ****
        FieldInfo:=Array(Array(1, 1), Array(2, 2), Array(3, 1)), _
        TrailingMinusNumbers:=True

wBook.SaveAs XlsFolder & Replace(fname, ".csv", ".xls")

这项工作的关键是FieldInfo参数。我将解释它正在做什么,因为它会要求您调整它以适合您的数据。

  • Array包含的元素等于文件中的分隔列数(在我的例子中有三个)。
  • 每个元素都是Array本身
  • Array(1,1)表示格式为General
  • 的第一列
  • Array(2,2)表示第二列的格式为Text
  • for good measure Array(3,1)表示第3列的格式为General

有关详细信息,请参阅手动转换文本到列时Convert Text to Columns Wizard中的步骤3。

答案 1 :(得分:1)

重写。测试看现在是否有效。

Sub CSVtoXls()

Dim CSVfolder As String
Dim XlsFolder As String
Dim fname As String
Dim LnLastRow As Long
Dim StString As String
Dim StSplit() As String
Dim wBook As Workbook
CSVfolder = "C:\Users\del44\Desktop\CSV Files\"
XlsFolder = "C:\Users\del44\Desktop\Excel Files\" 
fname = Dir(CSVfolder & "*.csv")
Do While fname <> ""
Set wBook = Workbooks.Open(CSVfolder & fname, Format:=6, Delimiter:="|")
LnLastRow = wBook.Sheets(1).Range("A1").End(xlDown).Row
For i = 1 To LnLastRow
    StString = wBook.Sheets(1).Cells(i, 1)
    StSplit() = Split(Mid(StString, 1), "|")
    For j = LBound(StSplit) To UBound(StSplit)
        wBook.Sheets(1).Cells(i, (j + 1)) = "'" & StSplit(j)
    Next j
Next i
wBook.SaveAs XlsFolder & Replace(fname, ".csv", ".xls"), FileFormat:=56
wBook.Close False
fname = Dir
Loop

Dim rCell As Range

End Sub

我已退出&#34; .textocolumns&#34;的选项。而是我分裂每个细胞。看看这是否有帮助!