如何通过VBA将长整型日期转为mm/dd/yy格式文本存储？

需要处理10万+条数据的日期列转换：

• 源数据日期以长整型存储（Excel日期本质是数值，长整型代表日期序列值）
• 目标是将其转换为mm/dd/yy格式的文本存储，实现类似Excel公式=TEXT(单元格,"mm/dd/yy")后复制粘贴值的效果
• 尝试过的方法存在问题：转换后显示为mm/dd/yyyy格式，用VBA转文本后又变回长整型；使用Application.WorksheetFunction.Text仅保留日期格式，目标列“Copy Attempt”始终为空
• 当前使用的VBA代码：

Option Explicit
Sub Format_Date()

Dim getString As String
Dim getLong As Long
Dim initialRowCount As Long
Dim stringRange As Range
Dim columnFromId As Integer
Dim columnToId As Integer
Dim startRow As Integer


'Get last row
initialRowCount = Cells(Rows.Count, 1).End(xlUp).Row

'Find "Formatted Record Date Column"

 getString = "Formatted Record Date"
    Set stringRange = ActiveSheet.Rows("1:1").Find(What:=getString, LookIn:=xlValues, _
                        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                        MatchCase:=True, SearchFormat:=False)
    columnFromId = stringRange.Column
    
 getString = "Copy Attempt"
    Set stringRange = ActiveSheet.Rows("1:1").Find(What:=getString, LookIn:=xlValues, _
                        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                        MatchCase:=True, SearchFormat:=False)
    columnToId = stringRange.Column

'Convert Format to Text

 For startRow = 2 To initialRowCount
      getString = CStr(Cells(startRow, columnFromId))
      Cells(startRow, columnToId) = WorksheetFunction.Text(getString, "mm/dd/yy")
      
    Next startRow

End Sub

原代码存在两个核心问题：

1. 错误转换数据类型：先把单元格的长整型日期用CStr()转成字符串，再传给WorksheetFunction.Text，此时函数会把字符串当作普通文本而非日期数值处理，无法正确解析为日期格式
2. 未设置目标单元格格式：即使生成了正确格式的文本，Excel会自动将识别为日期的文本重新转换为数值型日期，导致最终变回长整型

方案1：优化单循环处理（基础版） #

先设置目标列的单元格格式为文本，再直接处理源单元格的数值，生成指定格式的文本：

Option Explicit
Sub Format_Date_Text()
    Dim initialRowCount As Long
    Dim stringRange As Range
    Dim columnFromId As Integer
    Dim columnToId As Integer
    Dim startRow As Long ' 10万+行用Long避免溢出
    
    ' 获取最后一行
    initialRowCount = Cells(Rows.Count, 1).End(xlUp).Row
    
    ' 定位源列（Formatted Record Date）
    Set stringRange = ActiveSheet.Rows("1:1").Find(What:="Formatted Record Date", _
                        LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
    If stringRange Is Nothing Then Exit Sub ' 找不到列则退出
    columnFromId = stringRange.Column
    
    ' 定位目标列（Copy Attempt）
    Set stringRange = ActiveSheet.Rows("1:1").Find(What:="Copy Attempt", _
                        LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
    If stringRange Is Nothing Then Exit Sub
    columnToId = stringRange.Column
    
    ' 先将目标列设置为文本格式，避免Excel自动转换
    Columns(columnToId).NumberFormat = "@"
    
    ' 批量转换并赋值
    For startRow = 2 To initialRowCount
        ' 直接使用单元格数值（长整型日期序列），用Format函数生成指定格式的文本
        Cells(startRow, columnToId).Value = Format(Cells(startRow, columnFromId).Value, "mm/dd/yy")
    Next startRow
End Sub

方案2：数组批量处理（高效版，适合10万+数据） #

单循环处理10万行数据速度较慢，用数组批量读取和写入可大幅提升效率：

Option Explicit
Sub Format_Date_Array()
    Dim sourceArr As Variant
    Dim targetArr As Variant
    Dim initialRowCount As Long
    Dim stringRange As Range
    Dim columnFromId As Integer
    Dim columnToId As Integer
    Dim i As Long
    
    ' 获取最后一行
    initialRowCount = Cells(Rows.Count, 1).End(xlUp).Row
    If initialRowCount < 2 Then Exit Sub ' 无数据则退出
    
    ' 定位源列
    Set stringRange = ActiveSheet.Rows("1:1").Find(What:="Formatted Record Date", _
                        LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
    If stringRange Is Nothing Then Exit Sub
    columnFromId = stringRange.Column
    
    ' 定位目标列
    Set stringRange = ActiveSheet.Rows("1:1").Find(What:="Copy Attempt", _
                        LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
    If stringRange Is Nothing Then Exit Sub
    columnToId = stringRange.Column
    
    ' 将目标列设置为文本格式
    Columns(columnToId).NumberFormat = "@"
    
    ' 读取源列数据到数组
    sourceArr = Range(Cells(2, columnFromId), Cells(initialRowCount, columnFromId)).Value
    ' 初始化目标数组
    ReDim targetArr(1 To UBound(sourceArr, 1), 1 To 1)
    
    ' 批量转换格式
    For i = 1 To UBound(sourceArr, 1)
        targetArr(i, 1) = Format(sourceArr(i, 1), "mm/dd/yy")
    Next i
    
    ' 将数组写入目标列
    Range(Cells(2, columnToId), Cells(initialRowCount, columnToId)).Value = targetArr
End Sub

关键改动说明 #

• 先设置目标列格式为@（文本格式），从根源避免Excel自动将文本日期转换为数值
• 直接使用单元格的数值（而非转成字符串）进行格式转换，Format函数能正确解析Excel日期序列值
• 数组处理方案减少了VBA与Excel单元格的交互次数，10万+数据处理速度提升数倍

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