将字符串格式的日期更改为日期格式

Question

我正在编写一个格式化 Excel 电子表格的宏。

默认日期保存为文本。
通过 UI 更改它并将其记录为宏无法识别自动过滤器中的日期。

看起来像

Dim i As Integer
i = Cells.Find(What:="*", _
                After:=Range("C1"), _
                LookAt:=xlPart, _
                LookIn:=xlFormulas, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious, _
                MatchCase:=False).Row
Dim k As Integer

For k = 3 To i
    Cells(k, 3) = Format(Cells(k, 3), "dd mmmm yyyy;@")
    ' Changing the format like dd.mm.yyyy;@ doesn't work at all 
Next k

这会在 3 月、10 月等半个月中断。当我双击单元格进行编辑并按 Enter 键时，日期会正确保存并被自动过滤器识别。

电子表格内的外观示例：

Answer 1

想象一下我们想要将 A1:A13 中的以下文本转换为实数日期

Option Explicit

Public Sub Example()
    Dim RangeToConvert As Range
    Set RangeToConvert = Range("A1:A13")  ' define the range of texts DD.MM.YYYY you want to convert to real numeric dates
    
    ' read them into an array for faster processing
    Dim Data() As Variant
    Data = RangeToConvert.Value2
    
    ' convert all texts to dates in that array
    Dim iRow As Long
    For iRow = LBound(Data, 1) To UBound(Data, 1)
        Data(iRow, 1) = ConvertTextDDMMYYYYtoDate(Data(iRow, 1))
    Next iRow
    
    ' write the real numerc dates back to the cells
    RangeToConvert.Value2 = Data
    
    ' format the date to whatever you like
    RangeToConvert.NumberFormat = "DD. MMM YYYY" 'however you want it to look like
End Sub


Public Function ConvertTextDDMMYYYYtoDate(ByVal DateString As String) As Date
    Dim Parts() As String
    Parts = Split(DateString, ".")  ' split date 13.01.2022 into 3 parts
    
    Dim RetVal As Date
    
    If UBound(Parts) = 2 Then ' check if there were 3 parts in the text if not it's the wrong format in the DateString 
        RetVal = DateSerial(Parts(2), Parts(1), Parts(0))  ' put the 3 parts together to a numeric date
        
        ' check if the numeric date is the same as the DateString we had as input
        If Format$(RetVal, "DD.MM.YYYY") <> DateString Then
            ' if that is not the case it means the string was no valid date and cannot be converted
            MsgBox """" & DateString & """ is not a valid date in the format TT.MM.JJJJ"
            Exit Function
        End If
    Else
        MsgBox """" & DateString & """ is not in the format TT.MM.JJJJ"
        Exit Function
    End If
    
    ' return the value as real numeric date
    ConvertTextDDMMYYYYtoDate = RetVal
End Function

结果会是

我们为什么要这样做If Format$(RetVal, "DD.MM.YYYY") <> DateString Then？
因为如果您的字符串是“错误”的日期，例如35.01.2022，我们需要检测帽子。因为DateSerial 只会将其转换为日期04.02.2022，因为一月中不存在日期35。

---

根据评论编辑

如果您有多个列，则需要第二个循环来遍历列。

Dim iCol As Long
For iCol = LBound(Data, 2) To UBound(Data, 2)
    Dim iRow As Long
    For iRow = LBound(Data, 1) To UBound(Data, 1)
        Data(iRow, iCol ) = ConvertTextDDMMYYYYtoDate(Data(iRow, iCol ))
    Next iRow
Next iCol