导入制表符分隔的 CSV，制表符分隔符无法识别答案

【问题标题】：Import tab separated CSV, tab delimiter not recognized导入制表符分隔的 CSV，制表符分隔符无法识别
【发布时间】：2021-02-23 06:14:35
【问题描述】：

我有要转换为 xlsx 的制表符分隔的 csv 文件。所以每个 csv 都应该转换为 xlsx。文件名应该相同。但是，这些文件是制表符分隔的。例如，看这个测试文件截图：

当我运行我的代码时（我之前创建了一个子文件夹 xlsx）：

Sub all()

   Dim sourcepath As String
   Dim sDir As String
   Dim newpath As String
    
    sourcepath = "C:\Users\PC\Desktop\Test\"
    newpath = sourcepath & "xlsx\"
    
    'make sure subfolder xlsx was created before

    sDir = Dir$(sourcepath & "*.csv", vbNormal)
    Do Until Len(sDir) = 0
        Workbooks.Open (sourcepath & sDir)
        With ActiveWorkbook
            .SaveAs Filename:=Replace(Left(.FullName, InStrRev(.FullName, ".")), sourcepath, newpath) & "xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
            .Close
        End With
        
        sDir = Dir$
    Loop
End Sub

它确实有效，但是当我查看 excel 文件时：

我可以看到未检测到制表符分隔符。我认为我的本地设置是分隔符是分号，这就是它不起作用的原因。现在我想将 dataType 设置为 xlDelimited 并将 tab 设置为 True，将一行更改为：

Workbooks.Open (Spath & sDir), DataType:=xlDelimited, Tab:=True

我也试过

Workbooks.Open (Spath & sDir, DataType:=xlDelimited, Tab:=True)

或

Workbooks.Open FileName:=Spath & sDir, DataType:=xlDelimited, Tab:=True

但这会导致错误消息。然后我尝试了另一种方法，将分隔符设置为 Chr(9)（制表符）并将本地设置为 false：

Sub all()

    Dim wb As Workbook
    Dim strFile As String
    Dim strDir As String
    
    strDir = "C:\Users\PC\Desktop\Test\"
    strFile = Dir(strDir & "*.csv")
    
    Do While strFile <> ""
    
    Set wb = Workbooks.Open(Filename:=strDir & strFile, Delimiter:=Chr(9), Local:=False)
    With wb
        .SaveAs Replace(wb.FullName, ".csv", ".xlsx"), 51
        .Close True
    End With
    Set wb = Nothing
    strFile = Dir
    Loop
    
End Sub

它不会导致错误。但是当我打开文件时，它看起来像：

同样的问题，制表符分隔符无法识别。我该如何解决这个问题？

（我也尝试使用 local:True 和 Delimiter:=Chr(9)，但同样的问题，我也尝试添加 Format:=6）

我在 csv 中尝试过这种方式，因为我不想在 txt 文件扩展名中采用同样的方式。原因是使用 csv 很容易允许特殊语言字符，如“ö”和“ü”。所以这就是为什么我想将 csv 转换为 xlsx 而不是使用使用 txt 的解决方法，因为然后我遇到了一个问题，当我尝试将 txt 转换为 xlsx 时，某些特殊字符无法正确识别，我希望避免这种情况使用 csv 的问题。

csv（或者实际上这些是 tsv，因为它们将制表符作为分隔符而不是分号）文件具有不同的列。所以可能一个 csv 文件有 5 列，其他 6 列，数据类型也不同。

编辑：

回应 EEM 的回答：

检查这个 Test.csv 文件，它看起来像这样：

由制表符分隔。不是分号。

当我运行代码（加上 .TextFileDecimalSeparator = "." 到代码中）并检查生成的 xlsx 文件时，它看起来像这样：

第二列 (ColumnÄ) 中的值，如 9987.5 被正确转换为 9987,5。但是最后一列 (ColumnI) 中的值被错误地转换。这是我现在的问题。（我不知道为什么特殊字符不能正确转换，因为在我的原始文件中这确实有效。）

【问题讨论】：

您应该能够使用“数据”菜单下的功能区命令“文本到列”来处理工作表；将其设置为分隔符并包含“制表符”作为分隔符。录制宏以更轻松地获取所需的 VBA 代码。
回答更新关注数值数据的新信息，请测试。
感谢您一直以来的支持，我会接受您的回答。但是，最后一个问题：在生成的 xlsx 文件中，所有文件的工作表名称都是“Sheet1”。我想从文件名中继承这个。这样生成的工作表名与文件名相同（没有 .xslx）。这可能吗？

标签： excel vba csv import

【解决方案1】：

对于具有 csv 扩展名的分隔文件，Excel 的 Open 和 vba Workbooks.Open 和 Workbooks.OpenText 方法将始终假定分隔符是逗号，无论您在参数中输入什么。

您可以更改文件扩展名（例如更改为.txt），然后.Open 方法应该可以工作。
您可以将其读入 TextStream 对象并在 VBA 中逐行解析
您可以导入文件，而不是打开文件。

您可以使用Power Query 来导入它。
或者您可以使用下面代码的变体，它刚刚由宏记录器生成，因此您必须对其进行清理并根据您的具体情况对其进行一些调整。

With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;D:\Users\Ron\Desktop\myFile.csv", Destination:=Range("$A$12"))
        .CommandType = 0
        .Name = "weather_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

【讨论】：

感谢您的广泛回答。 Option1 txt 对我来说不是一种方法，因为我面临一个新问题，即 UTF-8 特殊字符（如 äö 等）未正确导入。关于option3的一个问题，因为这对我来说似乎是最好的解决方案：看起来如何，导入它而不是开放？关于 PowerQuery：我不仅有 1 个文件，而且有很多。 PowerQuery 是否允许以合理的方式对相当多的文件进行此操作，还是我必须为每个文件手动执行此操作？这不是我的选择。
vba 代码看起来不错，但是我认为我的能力太有限，无法动态调整 .TextFileColumnDataTypes 之类的内容。我有很多不同的文件。它们没有相同的数据类型等。每个文件的范围也不一样。
@BertHobe 我不明白您对数据类型的反对意见。您没有尝试在现有代码中设置它们。为什么需要在这段代码中设置它们？
好吧，我想是因为 .TextFileColumnDataTypes = Array(1, 1, 1, 1)？所以这明确地说明了数据类型，我认为我必须这样做并指定它？但我不知道，什么列是字符串或整数左右？所以我不知道如何把它放到我的循环中。
@BertHobe 这个方法可以说是最有效和最容易定制的方法，但它在您的环境中的实施似乎需要您尚未掌握的 VBA 知识水平。而且我在生成的代码中看不到任何硬编码的列名，所以我真的不知道问题是什么。如果问题是文件中的列名，则需要更改为某些标准；或将某些列按一定顺序排列，这在您最初的问题中没有解决。如果还有什么，请赐教。

【解决方案2】：

Text to Columns 应该适用于此：

Sub all()

   Dim sourcepath As String
   Dim sDir As String
   Dim newpath As String
    
    sourcepath = "C:\Users\snapier\Downloads\Test\"
    newpath = sourcepath & "xlsx\"
    
    'make sure subfolder xlsx was created before

    sDir = Dir$(sourcepath & "*.csv", vbNormal)
    Do Until Len(sDir) = 0
        Workbooks.Open (sourcepath & sDir)
        With ActiveWorkbook.Worksheets(1)
            .UsedRange.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=False
        End With
        With ActiveWorkbook
            .SaveAs Filename:=Replace(Left(.FullName, InStrRev(.FullName, ".")), sourcepath, newpath) & "xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
            .Close
        End With
        
        sDir = Dir$
    Loop
End Sub

【讨论】：

【解决方案3】：

正如@RonRosenfeld 所说，带有.csv 扩展名的文件将由excel 作为带有制表符分隔符的文本文件打开。

以下假设也不准确：

Option1 txt 不适合我，因为我面临 UTF-8 的新问题特殊字符，如 äö 等未正确导入。

字符或code page 的处理与文件的扩展名无关，而是由Workbooks.OpenText method 的Origin 参数或QueryTable 对象的TextFilePlatform property 管理。

因此，除非使用不同于csv 的扩展名重命名文件，否则[Workbooks.OpenText 方法] 将无效。

下面提出的解决方案使用QueryTable 对象并由两个过程组成：

Tab_Delimited_UTF8_Files_Save_As_Xlsx

设置源文件夹和目标文件夹
创建xlsx 文件夹（如果不存在）
获取源文件夹中的所有csv文件

Open_Csv_As_Tab_Delimited_Then_Save_As_Xls

处理每个csv 文件
添加一个工作簿来保存Query Table
导入 csv 文件
删除查询
将文件另存为 `xlsx'

EDIT I添加这些行是为了确保数字数据的转换：

                .TextFileDecimalSeparator = "."
                .TextFileThousandsSeparator = ","

EDIT II重命名工作表的一些更改（标记为'@）

用这个 csv 文件测试：

生成了这个 `xlsx' 文件：

希望将这些过程添加到您的项目中应该很简单，如果您对所使用的资源有任何问题或疑问，请告诉我。

Sub Tab_Delimited_UTF8_Files_Save_As_Xlsx()
Dim sFile As String
Dim sPathSrc As String, sPathTrg As String
Dim sFilenameSrc As String, sFilenameTrg As String
Dim bShts As Byte, exCalc As XlCalculation
    
Rem sPathSrc = "C:\Users\PC\Desktop\Test\"
    sPathTrg = sPathSrc & "xlsx\"
    
    Rem Excel Properties OFF
    With Application
        .EnableEvents = False
        .DisplayAlerts = False
        .ScreenUpdating = False
        exCalc = .Calculation
        .Calculation = xlCalculationManual
        .CalculateBeforeSave = False
        bShts = .SheetsInNewWorkbook
        .SheetsInNewWorkbook = 1
    End With

    Rem Validate Target Folder
    If Len(Dir$(sPathTrg, vbDirectory)) = 0 Then MkDir sPathTrg

    Rem Process Csv Files
    sFile = Dir$(sPathSrc & "*.csv")
    Do Until Len(sFile) = 0
        
        sFilenameSrc = sPathSrc & sFile
        sFile = Left(sFile, -1 + InStrRev(sFile, ".csv"))    '@
        sFilenameTrg = sPathTrg & sFile & ".xlsx"            '@
        
        Call Open_Csv_As_Tab_Delimited_Then_Save_As_Xls(sFile, sFilenameSrc, sFilenameTrg)    '@
        
        sFile = Dir$
    
    Loop

    Rem Excel Properties OFF
    With Application
        .SheetsInNewWorkbook = bShts
        .Calculation = exCalc
        .CalculateBeforeSave = True
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With
    
    End Sub

…

Sub Open_Csv_As_Tab_Delimited_Then_Save_As_Xls(sWsh As String, sFilenameSrc As String, sFilenameTrg As String)    '@
Dim Wbk As Workbook
    
    Rem Workbook - Add
    Set Wbk = Workbooks.Add
    With Wbk
        
        With .Worksheets(1)

            Rem QueryTable - Add
            With .QueryTables.Add(Connection:="TEXT;" & sFilenameSrc, Destination:=.Cells(1))
                
                Rem QueryTable - Properties
                .SaveData = True
                .TextFileParseType = xlDelimited
                .TextFileDecimalSeparator = "."
                .TextFileThousandsSeparator = ","
                .TextFileConsecutiveDelimiter = False
                .TextFileTabDelimiter = True
                .TextFileTrailingMinusNumbers = True
                .TextFilePlatform = 65001               'Unicode (UTF-8)
                .Refresh BackgroundQuery:=False
                
                Rem QueryTable - Delete
                .Delete
            
            End With
        
            Rem Rename Worksheet    '@
            On Error Resume Next    '@ Ignore error in case the Filename is not valid as Sheetname
            .Name = sWsh            '@
            On Error GoTo 0         '@
        
        End With

        Rem Workbook - Save & Close
        .SaveAs Filename:=sFilenameTrg, FileFormat:=xlOpenXMLWorkbook
        .Close
    
    End With

    End Sub

【讨论】：

我复制了您的代码并将 sPathSrc 调整到我的文件夹中（我确实注意最后有另一个“\”，所以不仅...\Test而且...\Test\。和你的完全一样。当我尝试运行你的代码时，我收到错误运行时错误 1004 excel 无法访问 workboox.xlsx 并且调试器标记 Set Wbk = Workbooks.Add(Template:="Workbook")。有什么问题在这里？
这可能与我的机器设置有关，默认情况下我确实有一个自定义工作簿，对此深表歉意。请将其更改为Workbooks.Add，尝试告诉我。
你的 Excel 使用的小数分隔符是什么？
csv 文件有“.”作为小数分隔符，您的 excel 也使用“.”，导入文件时使用“.”，但您需要使用“，”作为小数分隔符导入 csv 文件。这是正确的吗？
让我们continue this discussion in chat。

【解决方案4】：

使用 ADODB.Stream 对象，您可以创建用户定义的函数。

Sub all()

    Dim sourcepath As String
    Dim sDir As String
    Dim newpath As String
    Dim vResult As Variant
    Dim Wb As Workbook
    Dim Fn As String
     sourcepath = "C:\Users\PC\Desktop\Test\"
     newpath = sourcepath & "xlsx\"
     
     'make sure subfolder xlsx was created before
    
     sDir = Dir$(sourcepath & "*.csv", vbNormal)
     Application.ScreenUpdating = False
     Do Until Len(sDir) = 0
         'Workbooks.Open (sourcepath & sDir)
         'use adodb.stream
         vResult = TransToTextWithCsvUTF_8(sourcepath & sDir)
         Fn = Replace(sDir, ".csv", ".xlsx")
         
         Set Wb = Workbooks.Add
         With Wb
            Range("a1").Resize(UBound(vResult, 1) + 1, UBound(vResult, 2) + 1) = vResult
            .SaveAs Filename:=newpath & Fn, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
            .Close
         End With
         
         sDir = Dir$
     Loop
     Application.ScreenUpdating = True
End Sub

Function TransToTextWithCsvUTF_8(strFn As String) As Variant
    Dim vR() As String
    Dim i As Long, r As Long, j As Integer, c As Integer
    Dim objStream  As Object
    Dim strRead As String
    Dim vSplit, vRow
    Dim s As String
    
    Set objStream = CreateObject("ADODB.Stream")

    With objStream
        .Charset = "utf-8"
        .Open
        .LoadFromFile strFn
         strRead = .ReadText
        .Close
    End With
    
    vSplit = Split(strRead, vbCrLf)
    r = UBound(vSplit)
    c = UBound(Split(vSplit(0), vbTab, , vbTextCompare))
    ReDim vR(0 To r, 0 To c)
    
    For i = 0 To r
        vRow = Split(vSplit(i), vbTab, , vbTextCompare)
        If UBound(vRow) = c Then 'if it is empty line, skip it
            For j = 0 To c
                If IsNumeric(vRow(j)) Then
                    s = Format(vRow(j), "#,##0.000")
                    s = Replace(s, ".", "+")
                    s = Replace(s, ",", ".")
                    s = Replace(s, "+", ",")
                    vR(i, j) = s
                Else
                    vR(i, j) = vRow(j)
                End If
            Next j
        End If
    Next i
    TransToTextWithCsvUTF_8 = vR
    
    Set objStream = Nothing

End Function

【讨论】：

我复制了您的代码并将 sPathSrc 调整到我的文件夹中（我确实注意最后有另一个“\”，所以不仅...\Test而且...\Test\。和你的一样。当我尝试运行你的代码时，我得到错误运行时错误 9 index out of valid area 并且调试器标记 vR(i, j) = vRow(j) ?
@BertHobe，错误可能是因为文本文档中制表符分隔的字符数不同。可能是因为出错的行小于9。
那么每个txt文档可以有不同的列数吗？
@BertHobe，我编辑了答案。如果有空行，请跳过它。 If UBound(vRow) = c Then
@BertHobe，我认为你的代码是正确的，我没有审查它。

【解决方案5】：

此方法使用文件系统对象和文本流从制表符分隔更改为逗号分隔。在 Tools/References 中选择 Microsoft Scripting Runtime 以使所使用的库可用。如果分号分隔的也不能正确打开，可以用逗号替换fileContents = Replace(fileContents, vbTab, ";")行中REPLACE函数的第三个参数，然后重试。请注意，我们正在使用 Set textStreamObj = fileSystemObj.CreateTextFile("filePath2.csv") 创建一个 .csv 文件，而不是覆盖我们的原始文件。

Option Explicit

Sub changeDelimitedMarker()
    Dim fileSystemObj As Scripting.FileSystemObject
    Dim textStreamObj As Scripting.TextStream
    Dim fileContents As String
    
    Set fileSystemObj = New FileSystemObject
    Set textStreamObj = fileSystemObj.OpenTextFile("filePath1.csv")
    fileContents = textStreamObj.ReadAll
    textStreamObj.Close
    fileContents = Replace(fileContents, vbTab, ",")
    Set textStreamObj = fileSystemObj.CreateTextFile("filePath2.csv")
    textStreamObj.Write fileContents
    textStreamObj.Close
End Sub

【讨论】：

我的目标是将它从 csv 转换为 xlsx。所以不是filePath2.csv，而是xlsx。
@BertHobe ty for +1，记住一个 .csv 文件可以由工作簿直接打开然后保存为 .xlsx