Question

基本上，我需要将带有文本的批量.csv文件转换为列，并且文件应该在post＆＃34;，＆＃34;上转换为.xlsx。界定。

目前，我有示例代码但能够通过单击连接这些点。

Option Explicit

Sub OpenCSV()

    Dim fd As FileDialog

    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    fd.AllowMultiSelect = True
    fd.Show

    For Each fileItem In fd.SelectedItems

        Workbooks.OpenText Filename:= _
                           fileItem _
                           , Origin:=65001, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
                           xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
                           Comma:=False, Space:=False, Other:=False, TrailingMinusNumbers:=True

    Next

End Sub

Sub OpenCSVFolder()

    Dim fd As FileDialog

    Set fd = Application.FileDialog(msoFileDialogFolderPicker)

    fd.AllowMultiSelect = True
    fd.Show

    For Each folderItem In fd.SelectedItems

        fileItem = Dir(folderItem & "\" & "*.csv")

        While fileItem <> ""

            Workbooks.OpenText Filename:= _
                               folderItem & "\" & fileItem _
                               , Origin:=65001, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
                               xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
                               Comma:=False, Space:=False, Other:=False, TrailingMinusNumbers:=True
            fileItem = Dir

        Wend

    Next

End Sub

Sub CSVtoXLS()

    'UpdatebyExtendoffice20170814
    Dim xFd As FileDialog
    Dim xSPath As String
    Dim xCSVFile As String
    Dim xWsheet As String

    Application.DisplayAlerts = False
    Application.StatusBar = True

    xWsheet = ActiveWorkbook.Name

    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    xFd.Title = "Select a folder:"

    If xFd.Show = -1 Then
        xSPath = xFd.SelectedItems(1)
    Else
        Exit Sub
    End If

    If Right(xSPath, 1) <> "\" Then xSPath = xSPath + "\"

    xCSVFile = Dir(xSPath & "*.csv")

    Do While xCSVFile <> ""

        Application.StatusBar = "Converting: " & xCSVFile
        Workbooks.Open Filename:=xSPath & xCSVFile
        ActiveWorkbook.SaveAs Replace(xSPath & xCSVFile, ".csv", ".xls", vbTextCompare), xlNormal
        ActiveWorkbook.Close
        Windows(xWsheet).Activate
        xCSVFile = Dir
    Loop

    Application.StatusBar = False
    Application.DisplayAlerts = True

End Sub

Answer 1

第二个程序对我有用。你只能改变这一行：

ActiveWorkbook.SaveAs Replace(xSPath & xCSVFile, ".csv", ".xlsx", vbTextCompare), FileFormat:=51

你应该有＆＃34;，＆＃34;设置为系统中的分隔符。编辑：

如果您偶然使用了与.csv文件不同的默认分隔符，则可以使用以下代码填充循环：

Dim qT As QueryTable
Dim newWb As Workbook
Dim sFileName As String

Do While xCSVFile <> ""

    Application.StatusBar = "Converting: " & xCSVFile
    Set newWb = Application.Workbooks.Add
    sFileName = Replace(xSPath & xCSVFile, ".csv", ".xlsx", vbTextCompare)
    Set qT = newWb.Worksheets(1).QueryTables.Add(Connection:="TEXT;" & _
        xSPath & xCSVFile, Destination:=newWb.Worksheets(1).Range("A1"))
    With qT
        .FieldNames = True
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileOtherDelimiter = "," 'set your delimiter here
        .Refresh
    End With
    newWb.SaveAs sFileName, FileFormat:=51
    newWb.Close
    xCSVFile = Dir
Loop

我认为这可能对Google访问者有用

Excel-VBA宏。将包含文本的多个.csv文件转换为列，并将文件保存到xlsx

1 个答案: