运行Excel宏后日期格式意外变更问题求助

我写了一个Excel宏，仅用于移除硬空格（Chr(160)）和不可打印字符，没有修改任何日期格式的代码。但将工作表保存为Unicode文本文件时，日期格式却意外改变了。宏代码如下：

Sub CleanAndSaveEachSheetAsUnicodeText()
    Dim ws As Worksheet
    Dim originalPath As String
    Dim fileName As String
    Dim lastCol As Long
    Dim data As Variant
    Dim chunkSize As Long
    Dim i As Long, j As Long, k As Long
    Dim cellValue As String
    
    ' Set the chunk size for processing data
    chunkSize = 1000 ' Adjust as needed based on your data size
    
    ' Disable screen updating and automatic calculation
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    ' Loop through each worksheet in the workbook
    For Each ws In ThisWorkbook.Sheets
        ' Find the last column with data in the worksheet
        lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
        
        ' Get the last row with data
        Dim lastRow As Long
        lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
        
        ' Process data in chunks
        For i = 1 To lastRow Step chunkSize
            ' Determine the end row for the current chunk
            Dim endRow As Long
            endRow = WorksheetFunction.Min(i + chunkSize - 1, lastRow)
            
            ' Load data chunk into an array
            data = ws.Range(ws.Cells(i, 1), ws.Cells(endRow, lastCol)).Value
            
            ' Process each cell in the chunk
            For j = 1 To UBound(data, 1)
                For k = 1 To UBound(data, 2)
                    ' Check if the cell contains a value
                    If Not IsEmpty(data(j, k)) Then
                        ' Convert Chr(160) to space
                        cellValue = Replace(data(j, k), Chr(160), " ")
                        
                        ' Apply CLEAN function
                        cellValue = Application.Clean(cellValue)
                        
                        ' Remove line breaks and trim excess spaces
                        cellValue = Replace(cellValue, vbLf, " ")
                        cellValue = Replace(cellValue, vbCrLf, " ")
                        cellValue = Replace(cellValue, vbCr, " ")
                        cellValue = Trim(cellValue)
                        
                        ' Update cell value
                        data(j, k) = cellValue
                    End If
                Next k
            Next j
            
            ' Write cleaned data chunk back to the worksheet
            ws.Range(ws.Cells(i, 1), ws.Cells(endRow, lastCol)).Value = data
        Next i
        
        ' Columns AutoFit
        ws.Columns.AutoFit
        
        ' Get the original file path
        originalPath = ThisWorkbook.FullName
        
        ' Extract the sheet name
        fileName = ws.Name
        
        ' Save the worksheet as Unicode text with the sheet name in the same folder as the original file
        Dim filePath As String
        filePath = ThisWorkbook.Path & "\" & fileName & ".txt"
        ws.SaveAs Filename:=filePath, FileFormat:=xlUnicodeText
    Next ws
    
    ' Enable screen updating and automatic calculation
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

我期望得到数据未被改动的干净转换文本文件，但日期格式却被修改了。

1. 日期的存储特性：Excel中日期本质是序列数值（例如2024/05/20对应数值45432），宏中直接将data(j,k)赋值给cellValue时，会自动把日期数值转换为系统默认短日期格式的字符串，写回单元格后，单元格格式会被覆盖为默认格式，最终保存文本时就会输出转换后的格式，而非原显示格式。
2. SaveAs的输出逻辑：使用xlUnicodeText格式保存时，Excel会根据单元格的数字格式生成文本内容，若单元格格式被宏意外修改，输出的文本自然会和原显示不一致。

修改宏逻辑，处理单元格时区分日期类型，保留原显示字符串与格式，同时用临时工作簿导出文本避免修改原文件。以下是修正后的代码：

Sub CleanAndSaveEachSheetAsUnicodeText()
    Dim ws As Worksheet
    Dim filePath As String
    Dim lastCol As Long, lastRow As Long
    Dim data As Variant, cellFormats As Variant
    Dim chunkSize As Long
    Dim i As Long, j As Long, k As Long
    Dim cellValue As String
    
    chunkSize = 1000 ' 可根据数据量调整
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    For Each ws In ThisWorkbook.Sheets
        lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
        lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
        
        For i = 1 To lastRow Step chunkSize
            endRow = WorksheetFunction.Min(i + chunkSize - 1, lastRow)
            ' 同时加载单元格值与原格式
            data = ws.Range(ws.Cells(i, 1), ws.Cells(endRow, lastCol)).Value
            cellFormats = ws.Range(ws.Cells(i, 1), ws.Cells(endRow, lastCol)).NumberFormat
            
            For j = 1 To UBound(data, 1)
                For k = 1 To UBound(data, 2)
                    If Not IsEmpty(data(j, k)) Then
                        ' 判断是否为日期格式单元格
                        Dim isDateCell As Boolean
                        isDateCell = InStr(1, cellFormats(j, k), "m/d", vbTextCompare) > 0 _
                            Or InStr(1, cellFormats(j, k), "d/m", vbTextCompare) > 0 _
                            Or InStr(1, cellFormats(j, k), "yyyy", vbTextCompare) > 0
                            
                        ' 日期单元格取显示文本，非日期取值转字符串
                        cellValue = IIf(isDateCell, ws.Cells(i + j - 1, k).Text, CStr(data(j, k)))
                        
                        ' 执行清理操作
                        cellValue = Replace(cellValue, Chr(160), " ")
                        cellValue = Application.Clean(cellValue)
                        cellValue = Replace(cellValue, vbLf, " ")
                        cellValue = Replace(cellValue, vbCrLf, " ")
                        cellValue = Replace(cellValue, vbCr, " ")
                        cellValue = Trim(cellValue)
                        
                        ' 写回数据并保留原格式
                        If isDateCell Then
                            ws.Cells(i + j - 1, k).Value = cellValue
                            ws.Cells(i + j - 1, k).NumberFormat = cellFormats(j, k)
                        Else
                            data(j, k) = cellValue
                        End If
                    End If
                Next k
            Next j
            
            ' 批量写回非日期数据
            ws.Range(ws.Cells(i, 1), ws.Cells(endRow, lastCol)).Value = data
        Next i
        
        ws.Columns.AutoFit
        
        ' 用临时工作簿保存，避免修改原文件
        filePath = ThisWorkbook.Path & "\" & ws.Name & ".txt"
        Dim tempWB As Workbook
        Set tempWB = Workbooks.Add
        ws.Copy Before:=tempWB.Sheets(1)
        tempWB.SaveAs Filename:=filePath, FileFormat:=xlUnicodeText
        tempWB.Close SaveChanges:=False
    Next ws
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

1. 保留日期原显示：通过ws.Cells(...).Text获取单元格的显示文本，避免日期数值被自动转换为默认格式。
2. 还原单元格格式：记录并还原单元格的NumberFormat，确保保存文本时使用原格式输出。
3. 临时工作簿导出：复制工作表到临时工作簿后再保存，完全避免修改原文件的内容与格式。

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