批量导入 CSV 并选择分隔符答案

【问题标题】：Bulk importing CSV and choosing delimiter批量导入 CSV 并选择分隔符
【发布时间】：2022-10-07 01:04:22
【问题描述】：

我正在尝试在工作簿的文件夹中导入多个 CSV 文件，并将每个 csv 文件粘贴到单独的工作表中。我找到了this 线程来进行导入

Sub ImportCSVs()
Dim fPath   As String
Dim fCSV    As String
Dim wbCSV   As Workbook
Dim wbMST   As Workbook
Dim xFileDialog As FileDialog
Set wbMST = ThisWorkbook
Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = False
xFileDialog.Title = \"Select a folder\"
    If xFileDialog.Show = -1 Then
    fPath = xFileDialog.SelectedItems(1)
End If
fPath = xFileDialog.SelectedItems(1) & \"\\\"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
fCSV = Dir(fPath & \"\\\" & \"*.csv\")
On Error Resume Next
Do While Len(fCSV) > 0
    Set wbCSV = Workbooks.Open(fPath & fCSV)
    wbMST.Sheets(ActiveSheet.Name).Delete
    ActiveSheet.Move After:=wbMST.Sheets(wbMST.Sheets.Count)
    Columns.AutoFit
    fCSV = Dir
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Set wbCSV = Nothing
End Sub

这会导入，但我的 csv 文件中的分隔符是分号，并且脚本使用逗号分隔符并且表格会变得混乱，因为逗号用于表格的标题和十进制分隔符。我怎样才能改变它？

这已经在这里被问过好几次了。 Excel 使用 Windows 中设置的区域信息，因此除非您确定您的数据将匹配这些设置，否则最好自己拆分数据，并避免 Excel 内置 CSV 导入。
请尝试定义格式或/和分隔符关于.Open 方法
您可以尝试使用 Workbooks.OpenText 方法代替您可以定义分隔符的位置。我似乎记得，对于某些版本的 Excel，您需要将文件类型从 .csv 更改为 .txt。

标签： excel vba csv

【解决方案1】：

@Ron Rosenfeld 谢谢，这行得通。现在我只需要将所有数据文件更改为 .txt。

Sub ImportCSVs()
Dim fPath   As String
Dim fCSV    As String  
Dim wbCSV   As Workbook
Dim wbMST   As Workbook
Dim xFileDialog As FileDialog
Set wbMST = ThisWorkbook
Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = False
xFileDialog.Title = "Select a folder"
If xFileDialog.Show = -1 Then
fPath = xFileDialog.SelectedItems(1)
End If
fPath = xFileDialog.SelectedItems(1) & "\"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
fCSV = Dir(fPath & "\" & "*.txt")
On Error Resume Next
Do While Len(fCSV) > 0
Filename = fPath & fCSV
Workbooks.OpenText Filename:=Filename, DataType:=xlDelimited, Semicolon:=True, DecimalSeparator:=",", Comma:=False


wbMST.Sheets(ActiveSheet.Name).Delete
ActiveSheet.Move After:=wbMST.Sheets(wbMST.Sheets.Count)
Columns.AutoFit
fCSV = Dir
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Set wbCSV = Nothing
End Sub

【讨论】：

【解决方案2】：

这个怎么样？

Sub CombineTextFiles()

    Dim xFilesToOpen As Variant
    Dim I As Integer
    Dim xWb As Workbook
    Dim xTempWb As Workbook
    Dim xDelimiter As String
    Dim xScreen As Boolean
    On Error GoTo ErrHandler
    xScreen = Application.ScreenUpdating
    Application.ScreenUpdating = False
    xDelimiter = "|"
    xFilesToOpen = Application.GetOpenFilename("CSV Files (*.csv), *.csv", , "Kutools for Excel", , True)
    If TypeName(xFilesToOpen) = "Boolean" Then
        MsgBox "No files were selected", , ""
        GoTo ExitHandler
    End If
    I = 1
    Set xTempWb = Workbooks.Open(xFilesToOpen(I))
    xTempWb.Sheets(1).Copy
    Set xWb = Application.ActiveWorkbook
    xTempWb.Close False
    xWb.Worksheets(I).Columns("A:A").TextToColumns _
      Destination:=Range("A1"), DataType:=xlDelimited, _
      TextQualifier:=xlDoubleQuote, _
      ConsecutiveDelimiter:=False, _
      Tab:=False, Semicolon:=False, _
      Comma:=False, Space:=False, _
      Other:=True, OtherChar:="|"
    Do While I < UBound(xFilesToOpen)
        I = I + 1
        Set xTempWb = Workbooks.Open(xFilesToOpen(I))
        With xWb
            xTempWb.Sheets(1).Move after:=.Sheets(.Sheets.Count)
            .Worksheets(I).Columns("A:A").TextToColumns _
              Destination:=Range("A1"), DataType:=xlDelimited, _
              TextQualifier:=xlDoubleQuote, _
              ConsecutiveDelimiter:=False, _
              Tab:=False, Semicolon:=False, _
              Comma:=False, Space:=False, _
              Other:=True, OtherChar:=xDelimiter
        End With
    Loop
ExitHandler:
    Application.ScreenUpdating = xScreen
    Set xWb = Nothing
    Set xTempWb = Nothing
    Exit Sub
ErrHandler:
    MsgBox Err.Description, , "Excel"
    Resume ExitHandler
End Sub

【讨论】：