使用VBA从.csv复制日期到.xlsx时日期日与月互换问题求助

问题根源 #

• 日期解析错误：Excel打开CSV时会依据系统区域设置自动识别日期格式，当日期的日≤12时，会被误判为mm/dd/yyyy格式，导致日和月位置互换。
• 源文件被修改：用Workbooks.Open打开CSV后，Excel会自动将文本格式的日期转换为日期值，关闭时即使未手动保存，也可能因默认设置触发自动保存，改写源CSV文件。

解决方案 #

方法1：用QueryTables导入CSV（高效稳定，推荐） #

通过QueryTables直接读取CSV文本，指定日期列为文本格式导入，再转换为正确的日期格式，完全规避Excel自动解析日期的问题，同时不会修改源文件：

Sub collateData_QueryTables()
    Dim StrFile As String
    Dim wb As Workbook
    Dim destSht As Worksheet
    Dim pasteRow As Long, headerRowCount As Long
    Dim qt As QueryTable
    
    headerRowCount = 8
    pasteRow = headerRowCount + 1
    
    Set wb = Workbooks.Open(ThisWorkbook.Path & "/Member ID - LJW6127 - collated.xlsx")
    Set destSht = wb.Sheets("Hourly")
    
    StrFile = Dir("C:\Users\me\OneDrive\Member Id - LJW61Z7\*.csv")
    
    Do While Len(StrFile) > 0
        If Len(StrFile) = 26 Then
            ' 导入CSV，指定A列为文本格式避免自动日期解析
            Set qt = destSht.QueryTables.Add( _
                Connection:="TEXT;" & "C:\Users\me\OneDrive\Member Id - LJW61Z7\" & StrFile, _
                Destination:=destSht.Range("A" & pasteRow))
            
            With qt
                .TextFileParseType = xlDelimited
                .TextFileCommaDelimiter = True
                .TextFileColumnDataTypes = Array(xlTextFormat, xlGeneralFormat, xlGeneralFormat) 'A列文本，B、C列常规
                .TextFileStartRow = 9 '从第9行开始导入数据
                .Refresh BackgroundQuery:=False
                .Delete '导入完成后清理QueryTable对象
            End With
            
            ' 将A列文本转换为正确的日期格式
            Dim lastRow As Long
            lastRow = destSht.Cells(destSht.Rows.Count, "A").End(xlUp).Row
            With destSht.Range("A" & pasteRow & ":A" & lastRow)
                .NumberFormat = "dd/mm/yyyy hh:mm"
                .Value = .Value '强制转换为日期值
            End With
            
            ' 更新下一次粘贴的起始行
            pasteRow = lastRow + 1
        End If
        StrFile = Dir
    Loop
    
    wb.Save
    wb.Close
End Sub

方法2：直接读取CSV文本（精细控制） #

通过Open语句以文本方式读取CSV，手动解析日期格式，完全绕过Excel的自动解析机制：

Sub collateTextRead()
    Dim StrFile As String, lineText As String
    Dim wb As Workbook, destSht As Worksheet
    Dim pasteRow As Long, headerRowCount As Long
    Dim arrData As Variant, i As Long
    Dim fNum As Integer
    
    headerRowCount = 8
    pasteRow = headerRowCount + 1
    
    Set wb = Workbooks.Open(ThisWorkbook.Path & "/Member ID - LJW6127 - collated.xlsx")
    Set destSht = wb.Sheets("Hourly")
    
    StrFile = Dir("C:\Users\me\OneDrive\Member Id - LJW61Z7\*.csv")
    
    Do While Len(StrFile) > 0
        If Len(StrFile) = 26 Then
            fNum = FreeFile
            ' 以只读方式打开CSV文件
            Open "C:\Users\me\OneDrive\Member Id - LJW61Z7\" & StrFile For Input As #fNum
            
            ' 跳过前8行表头
            For i = 1 To headerRowCount
                Line Input #fNum, lineText
            Next i
            
            ' 逐行读取并解析数据
            Do Until EOF(fNum)
                Line Input #fNum, lineText
                arrData = Split(lineText, ",")
                If UBound(arrData) >= 2 Then
                    ' 手动解析日期：按dd/mm/yyyy hh:mm格式拆分转换
                    destSht.Cells(pasteRow, 1).Value = DateValue(Left(arrData(0), 10)) + TimeValue(Mid(arrData(0), 12))
                    destSht.Cells(pasteRow, 1).NumberFormat = "dd/mm/yyyy hh:mm"
                    ' 写入B、C列数据
                    destSht.Cells(pasteRow, 2).Value = arrData(1)
                    destSht.Cells(pasteRow, 3).Value = arrData(2)
                    pasteRow = pasteRow + 1
                End If
            Loop
            
            Close #fNum
        End If
        StrFile = Dir
    Loop
    
    wb.Save
    wb.Close
End Sub

注意事项 #

• 两种方法均不会打开源CSV文件（仅读取文本内容），彻底避免源文件被修改的问题。
• 若B、C列为数值类型，可根据需求调整代码中的数据类型转换逻辑。
• 导入后务必设置NumberFormat为dd/mm/yyyy hh:mm，确保日期显示格式统一。

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