使用VBA将TXT导入Excel时保留一位小数出错的解决需求

问题根源 #

TXT文件中的数值使用逗号作为小数分隔符，但VBA默认以点号作为小数分隔符，直接转换时逗号会被忽略，导致原始值216,450825被错误解析为整数216450825。

解决方案 #

需要先将字符串中的逗号替换为点号，转换为数值类型后再进行四舍五入，最后设置单元格格式以显示逗号作为小数分隔符。

修改核心代码片段 #

处理B列数值

替换原B列赋值逻辑为：

If xPosBeginText > 0 Then
    xPosBeginText = xPosBeginText + Len(xPlaceholder1)
    xTextLength = Len(text) - xPosBeginText - Len(xPlaceholder2)
    oWS.Cells(nextrow, "A").Value = Left(MyFile, InStr(MyFile, ".") - 1)
    
    ' 解析并格式化数值
    Dim xRawValue As String
    xRawValue = Trim(Mid(text, xPosBeginText, xTextLength))
    xRawValue = Replace(xRawValue, ",", ".") ' 替换逗号为点号适配VBA解析规则
    oWS.Cells(nextrow, "B").Value = Round(CDbl(xRawValue), 1) ' 保留一位小数
    oWS.Cells(nextrow, "B").NumberFormat = "0,0" ' 设置显示格式为逗号分隔小数
End If

处理C列数值

替换原C列赋值逻辑为：

If yPosBeginText > 0 Then
    yPosBeginText = yPosBeginText + Len(yPlaceholder1)
    yTextLength = Len(text) - yPosBeginText - Len(yPlaceholder2)
    
    ' 解析并格式化数值
    Dim yRawValue As String
    yRawValue = Trim(Mid(text, yPosBeginText, yTextLength))
    yRawValue = Replace(yRawValue, ",", ".")
    oWS.Cells(nextrow - 1, "C").Value = Round(CDbl(yRawValue), 1)
    oWS.Cells(nextrow - 1, "C").NumberFormat = "0,0"
End If

完整修改后的代码 #

Sub ExtractSizeTXT()
    Dim filename As String, nextrow As Long
    Dim MyFolder As String
    Dim MyFile As String
    Dim text As String
    Dim xPosBeginText As Long, xTextLength As Long, yPosBeginText As Long, yTextLength As Long
    Dim xPlaceholder1 As String, xPlaceholder2 As String, yPlaceholder1 As String, yPlaceholder2 As String
    Dim oWS As Worksheet
    Dim xRawValue As String, yRawValue As String
    
    xPlaceholder1 = "AAA"
    xPlaceholder2 = "BBB"
    yPlaceholder1 = "CCC"
    yPlaceholder2 = "DDD"
    Set oWS = ThisWorkbook.Sheets("ExtractSizeTXT")
    MyFolder = Application.ActiveWorkbook.Path & "\TXT\"
    MyFile = Dir(MyFolder & "*.txt")

    ' 简化清空操作
    With oWS
        .Range("A2:C" & .Cells(.Rows.Count, "A").End(xlUp).Row).ClearContents
    End With
    
    Do While MyFile <> ""
        Open (MyFolder & MyFile) For Input As #1
        Do Until EOF(1)
            Line Input #1, text
            xPosBeginText = InStr(1, text, xPlaceholder1, vbTextCompare)
            yPosBeginText = InStr(1, text, yPlaceholder1, vbTextCompare)
            
            nextrow = oWS.Cells(Rows.Count, "A").End(xlUp).Row + 1
            
            If xPosBeginText > 0 Then
                xPosBeginText = xPosBeginText + Len(xPlaceholder1)
                xTextLength = Len(text) - xPosBeginText - Len(xPlaceholder2)
                oWS.Cells(nextrow, "A").Value = Left(MyFile, InStr(MyFile, ".") - 1)
                
                xRawValue = Trim(Mid(text, xPosBeginText, xTextLength))
                xRawValue = Replace(xRawValue, ",", ".")
                oWS.Cells(nextrow, "B").Value = Round(CDbl(xRawValue), 1)
                oWS.Cells(nextrow, "B").NumberFormat = "0,0"
            End If
            
            If yPosBeginText > 0 Then
                yPosBeginText = yPosBeginText + Len(yPlaceholder1)
                yTextLength = Len(text) - yPosBeginText - Len(yPlaceholder2)
                
                yRawValue = Trim(Mid(text, yPosBeginText, yTextLength))
                yRawValue = Replace(yRawValue, ",", ".")
                oWS.Cells(nextrow - 1, "C").Value = Round(CDbl(yRawValue), 1)
                oWS.Cells(nextrow - 1, "C").NumberFormat = "0,0"
            End If
        Loop
        Close #1
        MyFile = Dir()
    Loop
    oWS.Rows(1).EntireRow.Delete
End Sub

内容的提问来源于stack exchange，提问作者wvds