VBA将CSV转换为XLSX

版权声明:本文为博主原创文章,遵循 CC 4.0 by-sa 版权协议,转载请附上原文出处链接和本声明。
本文链接:https://blog.csdn.net/u010314160/article/details/88252214

Sub 批量转换格式()
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Dim FilePath, MyFile, iPath As String
    iPath = ThisWorkbook.Path
    MyFile = Dir(iPath & "\*.CSV")
    
    On Error Resume Next

    Do While MyFile <> ""
        Rem 兼容两种分割类型
        If MyFile = "Sentence.csv" Then
            Workbooks.OpenText Filename:=iPath & "\" & MyFile, Origin:=65001, DataType:=xlDelimited, Tab:=True, Comma:=False
        Else
            Workbooks.OpenText Filename:=iPath & "\" & MyFile, Origin:=65001, DataType:=xlDelimited, Tab:=False, Comma:=True
        End If
        
        MyFile = iPath & "\" & Replace(ActiveWorkbook.Name, ".csv", ".xlsx", 1, -1, 1)
        With ActiveWorkbook.Sheets(1).UsedRange
            .Offset(1).SpecialCells(2, 1).NumberFormatLocal = "#,##0_ "
            For I = 1 To 5
               .Parent.Columns(I).ColumnWidth = .Parent.Columns(I).ColumnWidth * I
            Next I
            .Parent.Columns(1).NumberFormatLocal = "0_);(0)"
            .Parent.Parent.SaveAs Filename:=MyFile, FileFormat:=xlOpenXMLWorkbook
            .Parent.Parent.Close
        End With
        
        MyFile = Dir
        
    Loop
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
    Rem 这个开启后,如想再次编辑此宏,需要新建一个其他excel,打开此excel的同时按住shift阻止宏自动运行
    Rem Application.Quit
End Sub



展开阅读全文

没有更多推荐了,返回首页