如何阻止VBA读取TXT时将内容转换为美式日期格式

问题原因分析 #

1. 日期格式颠倒：CDate函数依赖系统区域设置解析日期。若你的TXT日期是dd/mm/yyyy格式，但系统区域为美式（mm/dd/yyyy），当日数值≤12时，会被自动识别为美式日期（日和月颠倒）；当日数值>12时，CDate无法匹配美式格式，才会按原格式保留，这就是部分行正常、部分错乱的核心原因。
2. 无效日期报错：00/00/0000不属于合法日期范围，CDate无法识别，直接调用会触发运行时错误。

解决办法 #

1. 强制按指定格式解析日期 #

放弃CDate，改用DateSerial函数手动拆分日、月、年构建日期，彻底摆脱系统区域限制：

' 替换原代码中CDate的行
Dim dateStr As String
dateStr = Mid(lineContent, 56, 10)
Dim parts As Variant
parts = Split(dateStr, "/")

' 确保拆分后是日/月/年三部分
If UBound(parts) = 2 Then
    Dim dayPart As Integer, monthPart As Integer, yearPart As Integer
    dayPart = Val(parts(0))
    monthPart = Val(parts(1))
    yearPart = Val(parts(2))
    
    ' 仅处理有效日期，无效日期保留原字符串
    If dayPart >= 1 And dayPart <= 31 And monthPart >= 1 And monthPart <= 12 And yearPart >= 1900 Then
        Cells(currentRow, 4) = DateSerial(yearPart, monthPart, dayPart)
        ' 手动设置单元格显示格式为dd/mm/yyyy
        Cells(currentRow, 4).NumberFormat = "dd/mm/yyyy"
    Else
        Cells(currentRow, 4) = dateStr
    End If
Else
    Cells(currentRow, 4) = dateStr
End If

2. 优化代码逻辑（避免Select/ActiveCell） #

原代码依赖Select和ActiveCell容易出错，改用变量跟踪行号，提升代码稳定性和效率：

Sub import_report_txt()
    Dim lineContent As String
    Dim currentRow As Long ' 用变量跟踪当前写入行
    
    Open "/Users/aniellima/Desktop/Macros/file.txt" For Input As #1
    
    Range("A5:G10000").ClearContents ' 清空目标区域，替代Range("A5:G10000") = Empty
    currentRow = 5 ' 起始行设为A5
    
    Do While Not EOF(1)
        Line Input #1, lineContent
        
        If IsNumeric(Mid(lineContent, 10, 12)) Then
            Cells(CtrEmpreendimento.Row, 1) = Mid(lineContent, 10, 12)
            Cells(NmeEmpreendimento.Row, 2) = Mid(lineContent, 23, 35)
        End If
        
        If IsNumeric(Mid(lineContent, 1, 12)) Then
            Cells(currentRow, 1) = Mid(lineContent, 1, 12)
            Cells(currentRow, 2) = Mid(lineContent, 14, 36)
            Cells(currentRow, 3) = Mid(lineContent, 51, 4)
            
            ' 处理日期列（第4列）
            Dim dateStr As String
            dateStr = Mid(lineContent, 56, 10)
            Dim parts As Variant
            parts = Split(dateStr, "/")
            
            If UBound(parts) = 2 Then
                Dim dayPart As Integer, monthPart As Integer, yearPart As Integer
                dayPart = Val(parts(0))
                monthPart = Val(parts(1))
                yearPart = Val(parts(2))
                
                If dayPart >= 1 And dayPart <= 31 And monthPart >= 1 And monthPart <= 12 And yearPart >= 1900 Then
                    Cells(currentRow, 4) = DateSerial(yearPart, monthPart, dayPart)
                    Cells(currentRow, 4).NumberFormat = "dd/mm/yyyy"
                Else
                    Cells(currentRow, 4) = dateStr
                End If
            Else
                Cells(currentRow, 4) = dateStr
            End If
            
            Cells(currentRow, 5) = Mid(lineContent, 67, 10)
            Cells(currentRow, 6) = CDbl(Mid(lineContent, 78, 11))
            Cells(currentRow, 7) = CDbl(Mid(lineContent, 90, 14))
            
            currentRow = currentRow + 1 ' 行号自增，替代ActiveCell.Select操作
        End If
    Loop
    
    Close 1
End Sub

关键说明 #

• DateSerial(year, month, day)强制按年、月、日顺序构建日期，完全不受系统区域设置影响，彻底解决格式颠倒问题。
• 提前判断日期各部分的有效性，既避免00/00/0000这类无效值触发错误，又保留原字符串方便后续处理。
• 移除Select和ActiveCell操作，代码运行更高效，也不会因手动操作Excel导致行号错乱。

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