VBA实现A列日期转周数 填充B列WEEKNUM公式代码求助

原代码存在的问题 #

• 循环逻辑错误：原代码按列遍历，且引用E、F列操作，和需求中遍历A列、结果写入B列的要求不匹配
• 多单元格判空逻辑失效：直接对多行区域取值判空，仅会校验区域左上角第一个单元格的内容，无法实现逐行匹配判断
• 公式写法错误：仅写入=weeknum未传入对应行的日期单元格参数，且公式写入起始行错设为第2行，不符合从B3开始写入的要求
• 缺少日期合法性校验：未判断单元格内容是否为有效日期，非日期内容写入公式会返回计算错误

修正后代码 #

Sub CalcWeekNum()
    Dim lastRow As Long, i As Long
    ' 定位A列最后一个有内容的行号，减少无效遍历
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    ' 从A3开始逐行遍历
    For i = 3 To lastRow
        ' 校验当前行A列是否为有效日期
        If IsDate(Cells(i, "A").Value) Then
            ' B列写入周数计算公式，参数2代表周一为每周起始，可按需改为1（周日为每周起始）
            Cells(i, "B").Formula = "=WEEKNUM(A" & i & ", 2)"
        Else
            ' 非日期内容对应B列留空
            Cells(i, "B").Value = ""
        End If
    Next i
End Sub

使用说明 #

• 代码会自动识别A列数据范围，不需要手动指定行数
• WEEKNUM第二参数可根据自身周统计规则调整：国内办公场景通常用参数2（周一为一周第一天），如果对接欧美体系数据可改为参数1（周日为一周第一天）
• 写入公式后B列单元格会自动计算对应日期的周数，后续A列日期修改时周数会自动更新

内容的提问来源于stack exchange，提问作者G.K.E2019