Excel VBA需求：基于两列范围差获取目标Range并填充日期

核心实现代码 #

Sub FillDateToTargetRange()
    Dim sh2 As Worksheet
    Dim AColLR As Long, BColLR As Long
    Dim targetRng As Range
    Dim myDate As Variant
    
    ' 定义Data工作表
    Set sh2 = ThisWorkbook.Worksheets("Data")
    
    ' 获取A列最后有数据的行号
    AColLR = sh2.Cells(sh2.Rows.Count, 1).End(xlUp).Row
    ' 获取B列最后有数据的行号
    BColLR = sh2.Cells(sh2.Rows.Count, 2).End(xlUp).Row
    
    ' 检查B列最后行是否大于A列最后行，避免无效范围
    If BColLR > AColLR Then
        ' 设置目标区域：A列从AColLR+1到BColLR行
        Set targetRng = sh2.Range(sh2.Cells(AColLR + 1, 1), sh2.Cells(BColLR, 1))
        
        ' 获取用户输入的日期
        myDate = InputBox("请输入对应数据的日期：", "日期输入")
        ' 验证输入是否为日期格式
        If IsDate(myDate) Then
            ' 批量填充日期，效率远高于循环
            targetRng.Value = CDate(myDate)
        Else
            MsgBox "输入的不是有效日期，请重新输入。", vbExclamation
        End If
    Else
        MsgBox "A列数据行数已等于或超过B列，无需填充。", vbInformation
    End If
End Sub

代码说明 #

1. 行号获取：用sh2.Rows.Count替代全局Rows.Count，避免因当前激活工作表不同导致的错误
2. 范围判断：先检查BColLR > AColLR，防止出现反向范围（比如A列数据比B列多的情况）
3. 批量赋值：直接给整个Range赋值，比循环逐个单元格赋值效率高得多，也避免循环逻辑错误
4. 输入验证：增加IsDate判断，确保用户输入的是有效日期

你之前代码的问题分析 #

1. DO UNTIL循环：每次循环都会重新执行sh2.Cells(Rows.Count, 1).End(xlUp)(2)，赋值后A列的最后行号会不断增加，导致循环永远无法终止，直接引发Excel崩溃
2. FOR EACH代码：Set rngC = sh2.Range(BColLR - AColLR)是错误的Range构造方式，Range需要地址或单元格对象，不是数字差值，所以范围根本没正确定义
3. 自定义函数：
   • 直接使用rngA = sh2.Range("A2:A" & AColLR)，对象赋值必须用Set，否则会报错
   • 函数逻辑是找rngA中不在rngB的区域，和你的需求（找A列中对应B列有数据的空白行）完全相反

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