3

我有一段 VBA 代码，可通过 www.contextures.com 获得。它使用户能够将多个条目添加到以逗号分隔的数据验证列表中。用户从日期列表和文本条目列表中进行选择。

用户可以自由键入日期，或使用选择列表来选择日期或文本条目。有时可能需要在一个单元格中输入两个日期，因此下面的 VBA 允许用户选择/键入一个日期，按 Enter，然后在同一单元格中键入另一个日期。一旦用户点击回车，前一个日期就会出现在单元格中，新日期后面用逗号分隔。

这是 VBA 的原始部分。

Option Explicit
' Developed by Contextures Inc.
' www.contextures.com
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
If Target.Count > 1 Then GoTo exitHandler

On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler

If rngDV Is Nothing Then GoTo exitHandler

If Intersect(Target, rngDV) Is Nothing Then
   'do nothing
Else
  Application.EnableEvents = False
  newVal = Target.Value
  Application.Undo
  oldVal = Target.Value
  Target.Value = newVal
  If Target.Column = 3 Then
    If oldVal = "" Then
      'do nothing
      Else
      If newVal = "" Then
      'do nothing
      Else
      Target.Value = oldVal _
        & ", " & newVal
      End If
    End If
  End If
End If

exitHandler:
  Application.EnableEvents = True
End Sub

问题是，当我在 VBA 适用的单元格中输入英国格式的日期（例如 01/06/2013 即 dd/mm/yyyy）时，VBA 正在干预并将日期返回为 06/01/2013（月/日/年）。

我的控制面板设置都是英国格式，所以我认为这与 VBA 如何存储然后返回日期有关。我尝试对 dims oldval 和 newval（到日期）进行修改，但是 VBA 不允许像以前一样在一个单元格中输入多个条目。

我将 VBA 修改为一个 hacky 解决方法（如下），它将日期格式化为非标准 dd.mm.yyyy（dd/mm/yyyy 不起作用），但这需要我告诉用户以这种格式输入日期我宁愿不这样做（我宁愿允许标准 01/01/2013 或 01-01-2013 两者都被 Excel 识别为日期）：

Option Explicit
' Developed by Contextures Inc.
' www.contextures.com
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
If Target.Count > 1 Then GoTo exitHandler

On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler

If rngDV Is Nothing Then GoTo exitHandler

If Intersect(Target, rngDV) Is Nothing Then
   'do nothing
Else
  Application.EnableEvents = False
  newVal = Format(Target.Value, "dd.mm.yyyy") 'amendment
  Application.Undo
  oldVal = Format(Target.Value, "dd.mm.yyyy") 'amendment
  Target.Value = newVal
  If Target.Column > 1 Then 'amendment
    If oldVal = "" Then
      'do nothing
      Else
      If newVal = "" Then
      'do nothing
      Else
      Target.Value = oldVal _
        & ", " & newVal
      End If
    End If
  End If
End If

exitHandler:
  Application.EnableEvents = True
End Sub

我使用的是 Excel 2007，但电子表格需要与 2003 兼容。

编辑：数据的外观在这个问题中：Excel 2003 - 如何计算行中的日期，包括单元格中的多个日期

编辑：我还应该提到，如果我在单元格中输入 01/07/2013 两次，结果如下：

07/01/2013, 01/07/2013

这就像第一次填充单元格时将其切换为美国日期格式，但之后的任何内容都可以。

4

4 回答 4

2

好的，所以在阅读了这篇文章之后：http: //allenbrowne.com/ser-36.html 我对代码做了一些调整：

 Option Explicit
' Developed by Contextures Inc.
' www.contextures.com
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
If Target.Count > 1 Then GoTo exitHandler

On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler

If rngDV Is Nothing Then GoTo exitHandler

If Intersect(Target, rngDV) Is Nothing Then
   'do nothing
Else
  Application.EnableEvents = False
  'newVal = Target.Value 'amendment
  newVal = Format(Target.Value, "\ dd\/mm\/yyyy\")

  Application.Undo
  'oldVal = Target.Value 'amendment
  oldVal = Format(Target.Value, "\ dd\/mm\/yyyy\")
  Target.Value = newVal
  If Target.Column > 1 Then 'amendment
    If oldVal = "" Then
      'do nothing
      Else
      If newVal = "" Then
      'do nothing
      Else
      Target.Value = oldVal _
        & ", " & newVal
      End If
    End If
  End If
End If

exitHandler: Application.EnableEvents = True End Sub

重要的一点似乎是格式：

oldVal = Format(Target.Value, "\ dd\/mm\/yyyy\")

艾伦建议的代码是：

Format$(varDate, "\#mm\/dd\/yyyy\#")

我将其更改为 dd/mm 并将 # 替换为一个空格，嘿 presto - 它似乎正在工作！不过，这是一个非常令人沮丧的问题，我现在必须确保它可以在其他用户的机器上运行！感谢@sous2817 和@GSerg 的评论/建议。

于 2013-05-02T08:52:25.737 回答
0

这似乎对我有用......除非我想念你的问题......

newVal = Format(Sheet1.Range("A1"), "dd/mm/yyyy;@")

完整代码：

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
If Target.Count > 1 Then GoTo exitHandler

On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler

If rngDV Is Nothing Then GoTo exitHandler

If Intersect(Target, rngDV) Is Nothing Then
   'do nothing
Else
  Application.EnableEvents = False
  newVal = Format(Target.Value, "dd/mm/yyyy;@") 'amendment
  Application.Undo
  oldVal = Format(Target.Value, "dd/mm/yyyy;@") 'amendment
  Target.Value = newVal
  If Target.Column > 1 Then 'amendment
    If oldVal = "" Then
      'do nothing
      Else
      If newVal = "" Then
      'do nothing
      Else
      Target.Value = oldVal _
        & ", " & newVal
      End If
    End If
  End If
End If

exitHandler:
  Application.EnableEvents = True
End Sub
于 2013-04-30T20:18:26.760 回答
0

我遇到了一个类似的问题 - 我的 VBA 代码将一个单元格值作为英国格式“DD/MM/YYYY”的字符串写入了一个本地日期格式设置为 DD/MM/YYYY 但日期以美国格式 MM/DD 出现的单元格中/YYYY。

上面的讨论非常有助于将其识别为 VBA 正在做的事情，而不是我的代码。为了解决这个问题，我编写了一个函数来将我的英国日期字符串转换为美国格式日期字符串，并将美国格式日期字符串写入单元格。VBA 然后在工作表中将美国日期处理成英国日期，这就是我想要的！

Public Function MM_DD_YYYY(DD_MM_YYYY As String) As String ' 函数将日期格式从 DD/MM/YYYY 切换到 MM/DD/YYYY Dim DD As String Dim MM As String Dim YYYY As String DD = Left(DD_MM_YYYY, 2) MM = Mid (DD_MM_YYYY, 4, 2) YYYY = Right(DD_MM_YYYY, 4) MM_DD_YYYY = MM & "/" & DD & "/" & YYYY 结束函数

于 2021-01-30T23:55:47.967 回答
-1

只是这个小小的改变对我来说非常有用。

newVal = Format(Sheet1.Range("A1"), " mm-dd -yyyy;@")

我的 VBA 选择日期为美国格式（mm-dd-yyyy）。我想要英国格式 (dd-mm-yyyy)

我只是使用上面的代码将值读取为美国格式本身，因此 VBA 可以正确选择日期和月份。最终，因为我的系统设置是基于英国的，最终结果是英国格式。

于 2019-12-03T14:00:24.683 回答