为何VBA始终以美式格式插入日期？Power Query表格日期格式问题

我通过Power Query构建了一个表格，包含Appointed和Date Appointed两个空白列。Date Appointed列已在Power Query中设置为仅日期格式，采用英式区域设置，表格列的格式界面也显示为英式日期。需求是：当在Appointed列的下拉菜单选择“Yes”时，VBA自动将当日日期填入Date Appointed列。

当前代码功能正常，但插入的日期始终是美式格式（比如实际应为05/12/2023，却显示为美式格式），代码如下：

Private Sub Worksheet_Change(ByVal Target As Range)

Dim KeyCells As Range

' The variable KeyCells contains the cells that will cause an input
'date and time in next 2 cells to the right when active cell is changed.

Set KeyCells = ActiveSheet.ListObjects("VAMP_P1___P2").ListColumns("Appointed").Range

If Not Application.Intersect(KeyCells, Range(Target.Address)) _
    Is Nothing Then
    
    If Target = "Yes" Then
        ActiveCell.Offset(0, 4).Value = Format(Now, "dd/mm/yyyy")
    Else
        Dim answer As Integer

        answer = MsgBox("Changing this cell to anything other than 'Yes' will reset any previous appointed date, would you like to proceed?", vbQuestion + vbYesNo + vbDefaultButton2, "Message Box Title")
        
        If answer = vbYes Then
          ActiveCell.Offset(0, 4).ClearContents
        Else
        End If

    End If
    
    End If

End Sub

解决方案 #

问题核心是Format(Now, "dd/mm/yyyy")返回的是文本格式的日期，而非真正的日期值。即使单元格设置了英式格式，文本日期会被Excel按系统区域规则解析，导致显示错误。

修正步骤 #

1. 直接写入日期值：放弃Format函数，用Date（仅日期）或Now（日期+时间）返回原生日期值，Excel会自动匹配单元格的英式格式：

   Target.Offset(0, 4).Value = Date ' 仅写入日期部分，符合需求
   

2. 替换ActiveCell为Target：ActiveCell可能在事件触发后被切换，用Target（触发事件的单元格）更可靠，确保操作对应行的Date Appointed列。
3. 添加事件禁用/启用：防止写入日期时递归触发Worksheet_Change事件，避免循环或错误。

修正后的完整代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Set KeyCells = ActiveSheet.ListObjects("VAMP_P1___P2").ListColumns("Appointed").Range

    If Not Application.Intersect(KeyCells, Target) Is Nothing Then
        ' 禁用事件防止递归
        Application.EnableEvents = False
        
        If Target.Value = "Yes" Then
            Target.Offset(0, 4).Value = Date ' 写入原生日期值
        Else
            Dim answer As Integer
            answer = MsgBox("Changing this cell to anything other than 'Yes' will reset any previous appointed date, would you like to proceed?", vbQuestion + vbYesNo + vbDefaultButton2, "Message Box Title")
            
            If answer = vbYes Then
                Target.Offset(0, 4).ClearContents
            End If
        End If
        
        ' 恢复事件
        Application.EnableEvents = True
    End If
End Sub

说明 #

• 原生日期值会被Excel识别为日期类型，完全遵循单元格已设置的英式格式显示，不会出现格式混乱。
• Application.EnableEvents的开关是VBA处理工作表变更事件的标准操作，避免意外触发多次事件。

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