如何在Excel同一工作表的两个单元格区域实现日期输入VBA效果

嘿，这个需求很好实现，核心就是调整代码里的目标区域判断逻辑，让它同时覆盖B列和E列的指定范围就行。我给你两种实用的方案，你可以根据自己的后续扩展需求选择：

方案一：直接合并目标区域（简单直接） #

原来的代码只判断了B列的B4:B1048576，你只需要把E列的同范围区域和它合并，传给Intersect函数就行。修改后的关键代码如下：

If Application.Intersect(Target, Range("B4:B1048576, E4:E1048576")) Is Nothing Then Exit Sub

把这段替换你原代码里的对应行，就能让代码同时对B列和E列生效了。

如果要更简洁，也可以用Columns和Union来组合区域（效果完全一样）：

Dim targetRange As Range
Set targetRange = Union(Range("B4:B" & Rows.Count), Range("E4:E" & Rows.Count))
If Application.Intersect(Target, targetRange) Is Nothing Then Exit Sub

方案二：用数组管理目标列（扩展性强） #

如果以后可能还要给更多列加这个日期格式效果，推荐用数组来管理目标列，这样后续只要修改数组内容就行，不用动核心判断逻辑：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim DateStr As String
    Dim targetColumns As Variant
    Dim col As Variant
    Dim targetRange As Range
    
    ' 关闭事件触发，避免递归（修改单元格时再次触发Change事件）
    Application.EnableEvents = False
    
    On Error GoTo EndMacro
    
    ' 定义需要生效的列
    targetColumns = Array("B", "E")
    
    ' 遍历目标列，构建完整的目标区域
    For Each col In targetColumns
        If targetRange Is Nothing Then
            Set targetRange = Range(col & "4:" & col & Rows.Count)
        Else
            Set targetRange = Union(targetRange, Range(col & "4:" & col & Rows.Count))
        End If
    Next col
    
    ' 判断当前修改的单元格是否在目标区域内
    If Application.Intersect(Target, targetRange) Is Nothing Then Exit Sub
    
    ' 这里放你原来处理日期格式的代码（和之前完全一样）
    ' ...（你的原代码逻辑）...

EndMacro:
    ' 恢复事件触发
    Application.EnableEvents = True
End Sub

额外提醒 #

不管用哪种方案，都建议加上Application.EnableEvents = False和True的开关——因为当你修改单元格格式时，可能会再次触发Worksheet_Change事件，导致代码递归运行，容易出现卡顿或错误。原来的代码运行良好可能是因为逻辑里没有修改单元格内容/格式，但加上这个开关更稳妥。

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