如何在Excel VBA模块中调用自定义函数批量处理日期列数据

你原来写的ReturnCellToLeft函数依赖Application.Caller属性，该属性仅在函数被工作表单元格作为公式调用时，才会返回调用该公式的单元格对象，直接在VBA模块的过程中调用时没有对应的调用方单元格，因此无法直接复用原有逻辑，你可以选择以下任意一种方案实现需求：

方案1：改造自定义函数，支持VBA直接调用 #

修改函数逻辑，新增可选的单元格传入参数，同时兼容公式调用和VBA调用两种场景：

Function ReturnCellToLeft(Optional sourceCaller As Range) As Variant
    If sourceCaller Is Nothing Then
        ' 适配单元格公式调用场景，保留原有逻辑
        If TypeName(Application.Caller) = "Range" Then
            ReturnCellToLeft = Application.Caller.Offset(0, -4).Value
        Else
            ReturnCellToLeft = vbNullString
        End If
    Else
        ' 适配VBA调用场景，使用传入的调用方单元格
        ReturnCellToLeft = sourceCaller.Offset(0, -4).Value
    End If
End Function

之后编写批量处理的遍历过程即可调用：

Sub 批量提取日期()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    ' 按需修改下方工作表、列号参数
    Set ws = ActiveSheet ' 可替换为具体工作表，如Worksheets("数据")
    Const 公式所在列 = 5 ' 原手动输入公式的列号，对应offset(-4)取到第1列的源数据
    Const 结果写入列 = 6 ' 处理后的日期要写入的列号
    
    ' 自动获取源数据最后一行
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    ' 遍历所有数据行，跳过表头请把起始i改成2
    For i = 1 To lastRow
        ' 调用改造后的自定义函数，传入对应行的公式列单元格
        Dim rawText As String
        rawText = ReturnCellToLeft(ws.Cells(i, 公式所在列))
        ' 提取日期，支持转成标准日期格式
        ws.Cells(i, 结果写入列).Value = CDate(Mid(rawText, 8))
    Next i
End Sub

方案2：无需改造函数，批量写入公式再转值 #

如果不想调整原有自定义函数，可以直接给所有目标单元格批量写入公式，再批量转成纯值，效果和手动输入公式一致：

Sub 批量写入公式转值()
    Dim ws As Worksheet
    Dim lastRow As Long
    Const 公式写入列 = 5 ' 要输入公式的列
    
    Set ws = ActiveSheet
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    ' 批量写入公式
    ws.Range(ws.Cells(1, 公式写入列), ws.Cells(lastRow, 公式写入列)).Formula = _
        "=RIGHT(ReturnCellToLeft(),LEN(ReturnCellToLeft())-7)"
    ' 批量转为纯值，去掉公式
    ws.Range(ws.Cells(1, 公式写入列), ws.Cells(lastRow, 公式写入列)).Value = _
        ws.Range(ws.Cells(1, 公式写入列), ws.Cells(lastRow, 公式写入列)).Value
End Sub

方案3：省略自定义函数，直接批量处理 #

如果不需要保留单元格调用的自定义函数，完全可以直接在遍历过程中处理数据，代码更简洁高效：

Sub 直接批量提取日期()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    
    Set ws = ActiveSheet
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    ' 遍历处理，A列是源数据列，C列写入结果，按需调整
    For i = 1 To lastRow
        ws.Cells(i, 3).Value = CDate(Mid(ws.Cells(i, 1).Value, 8))
    Next i
End Sub

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