Excel VBA读取CSV时如何保留管道尺寸原始格式并解决数据缺失问题

问题概况 #

• VBA代码导入CSV时，无法识别英寸符号（"），会截断符号后的内容（例如1"变为1，后续数据丢失）
• service、line nr.和from/to字段的数据未显示
• 移除原始数据中的英寸符号后，整数显示正常，但分数3/4被自动转换为数值44624（Excel将其识别为1900年3月4日的日期序列号）

原始VBA代码 #

Private Sub Workbook_Open()
        
    Call FormatCells
    Call GetDataFromCSVFile
    Call separateData
    Call CreateHeader
        
End Sub
    
Sub GetDataFromCSVFile()
    '
    ' Creates connection to extracted file
    ' Export to new file
    '
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim defaultDirectory As String
    Dim SQLString As String
    
    defaultDirectory = Dir(ThisWorkbook.path & "\extractfiles\*.csv")
    
    Sheet1.Cells.Clear
    
    Set cn = New ADODB.Connection
    
    cn.ConnectionString = _
    "Driver={Microsoft Text Driver (*.txt; *.csv)};" & _
    "Dbq=" & ThisWorkbook.path & "\extractfiles\;" & _
    "Extensions=asc,csv,tab,txt;"
    
    cn.Open
    
    Set rs = New ADODB.Recordset
    
    rs.ActiveConnection = cn
    rs.Source = "SELECT * FROM [DATA-FLOWCODE.csv]"
    rs.Open
        
    Sheet1.Range("A1").CopyFromRecordset rs
    
    rs.Close
    cn.Close
    
    'Move to 2nd row to create header rows on A1
    Sheet1.Range("A1").CurrentRegion.EntireColumn.AutoFit
    
End Sub

'***
Sub FormatCells()
    '
    ' test1 Macro
    ' format cells
    '
    Cells.Select
    Selection.NumberFormat = "@"
    Cells.EntireColumn.AutoFit
        
    'Format this columns as fractions
    With ActiveSheet
        With .Range("C7", .Cells(.Rows.Count, "C").End(xlUp))
            .Select
            .NumberFormat = "# ?/?"
        End With
    End With
        
End Sub
'***

格式设置规则（必做） #

1. 导入前强制文本格式
   在导入CSV数据前，先将目标工作表的所有单元格设置为文本格式，避免Excel自动推断数据类型。修改GetDataFromCSVFile，在Sheet1.Cells.Clear后添加：

   Sheet1.Cells.NumberFormat = "@"
   

2. 修改ADODB连接参数
   在连接字符串中添加IMEX=1，强制文本驱动将所有列按文本读取，避免自动识别为数值/日期：

   cn.ConnectionString = _
   "Driver={Microsoft Text Driver (*.txt; *.csv)};" & _
   "Dbq=" & ThisWorkbook.path & "\extractfiles\;" & _
   "Extensions=asc,csv,tab,txt;" & _
   "IMEX=1;"
   

3. 移除错误的分数格式设置
   删掉FormatCells中对C列设置# ?/?的代码，该格式会将文本分数转换为日期/数值，完全破坏原始格式。

4. 指定CSV分隔符（可选）
   如果你的CSV是分号分隔（如示例中的[1];1;2），在连接字符串中添加Delimiter=;，避免驱动误解析分隔符导致字段丢失：

   cn.ConnectionString = _
   "Driver={Microsoft Text Driver (*.txt; *.csv)};" & _
   "Dbq=" & ThisWorkbook.path & "\extractfiles\;" & _
   "Extensions=asc,csv,tab,txt;" & _
   "IMEX=1;" & _
   "Delimiter=;"
   

格式设置规则（必避） #

• 禁止导入后再设置文本格式：此时Excel已经完成数据类型转换，无法恢复原始内容
• 禁止对文本格式的尺寸列设置数字/分数格式：会触发Excel自动转换，导致分数变日期、丢失英寸符号
• 禁止依赖Excel自动数据类型识别：特殊格式的管道尺寸必须强制按文本处理

修改后的核心代码示例 #

调整后的GetDataFromCSVFile #

Sub GetDataFromCSVFile()
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim defaultDirectory As String
    
    defaultDirectory = Dir(ThisWorkbook.path & "\extractfiles\*.csv")
    
    Sheet1.Cells.Clear
    ' 提前设置所有单元格为文本格式
    Sheet1.Cells.NumberFormat = "@"
    
    Set cn = New ADODB.Connection
    
    cn.ConnectionString = _
    "Driver={Microsoft Text Driver (*.txt; *.csv)};" & _
    "Dbq=" & ThisWorkbook.path & "\extractfiles\;" & _
    "Extensions=asc,csv,tab,txt;" & _
    "IMEX=1;" & _
    "Delimiter=;" ' 适配分号分隔的CSV
    
    cn.Open
    
    Set rs = New ADODB.Recordset
    rs.ActiveConnection = cn
    rs.Source = "SELECT * FROM [DATA-FLOWCODE.csv]"
    rs.Open
        
    Sheet1.Range("A1").CopyFromRecordset rs
    
    rs.Close
    cn.Close
    
    Sheet1.Range("A1").CurrentRegion.EntireColumn.AutoFit
End Sub

简化后的FormatCells #

Sub FormatCells()
    ' 统一设置为文本格式并自动调整列宽
    Sheet1.Cells.NumberFormat = "@"
    Sheet1.Cells.EntireColumn.AutoFit
End Sub

内容的提问来源于stack exchange，提问作者B.D.