Excel VBA - 日期格式转换 [英] Excel VBA - Date Format Conversion

问题描述

我遇到了一个具有挑战性的任务，我无法解决使用许多解决方法。

I have come across a challenging task which I am not able to solve using many workarounds.

在一列中有日期，日期可以在以下三个格式：

In one column I have dates, the date can be in following three formats:

1）简单的dd / mm / yy

1) Simple dd/mm/yy

2）dd / mm / yy，但可能在其周围有之前，之后或之后。任何
其中一个，我们只需要删除这种情况下的这些单词。

2) dd/mm/yy but may have words "before,after or about" around it. Any one of it and we just need to delete those words in this case.

3）数字格式的日期。一个长十进制值，如1382923.2323
，但实际上我可以从转换后得到一个日期。

3) Date in a numeric format. A long decimal values like 1382923.2323 but actually I can get a date from it after conversion.

文件在这里上传。 Date_format_macro_link

The file is uploaded here. Date_format_macro_link

我写了下面的代码，但是它的结果是错误的。

I wrote the following code but it's giving wrong results.

Sub FormatDates_Mine()
    ManualSheet.Activate
    ManualSheet.Cells.Hyperlinks.Delete
    ManualSheet.Cells.Interior.ColorIndex = xlNone
    ManualSheet.Cells.Font.Color = RGB(0, 0, 0)

    lastRow = ManualSheet.Range("A" & Rows.Count).End(xlUp).Row
    Col = "A"
    For i = 2 To lastRow
        Cells(i, Col) = Trim(Replace(Cells(i, Col), vbLf, "", 1, , vbTextCompare))

        If InStr(1, Cells(i, Col), "about", vbTextCompare) <> 0 Then
            Cells(i, Col) = Trim(Replace(Cells(i, Col), "about", "", 1, , vbTextCompare))
            Cells(i, Col).Interior.Color = RGB(217, 151, 149)
        End If

        If InStr(1, Cells(i, Col), "after", vbTextCompare) <> 0 Then
            Cells(i, Col) = Trim(Replace(Cells(i, Col), "after", "", 1, , vbTextCompare))
            Cells(i, Col).Interior.Color = RGB(228, 109, 10)
        End If

        If InStr(1, Cells(i, Col), "before", vbTextCompare) <> 0 Then
            Cells(i, Col) = Trim(Replace(Cells(i, Col), "before", "", 1, , vbTextCompare))
            Cells(i, Col).Interior.Color = RGB(228, 109, 10)
        End If

        DateParts = Split(Cells(i, Col), "/", , vbTextCompare)

        Cells(i, Col) = Format(Cells(i, Col), "dd/mm/yyyy")
    Next i

    Range("D:E").HorizontalAlignment = xlCenter
End Sub

此处将文件上传。 Date_format_macro_link

The file is uploaded here. Date_format_macro_link

请帮助！

推荐答案

这是你正在尝试吗？我没有添加任何错误处理。我假设你不会偏离现有的数据格式。如果格式发生变化，那么您将不得不引入错误处理。

Is this what you are trying? I have not added any error handling. I am assuming that you will not be deviating for the existing format of your data. If the format changes then you WILL have to introduce error handling.

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim lRow As Long, i As Long
    Dim rng As Range
    Dim MyAr() As String

    Set ws = ThisWorkbook.Sheets("Data")

    With ws
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row

        Set rng = .Range("A2:A" & lRow)

        With rng
            '~~> Replace "After " in the entire column
            .Replace What:="After ", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False

            DoEvents

            '~~> Replace "About " in the entire column
            .Replace What:="About ", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False

            .NumberFormat = "dd/mm/yyyy"
        End With

        For i = 2 To lRow
            '~~> Remove the End Spaces
            .Range("A" & i).Value = Sid_SpecialAlt160(.Range("A" & i).Value)

            '~~> Remove time after the space
            If InStr(1, .Range("A" & i).Value, " ") Then _
            .Range("A" & i).Formula = Split(.Range("A" & i).Value, " ")(0)

            '~~> Convert date like text  to date
            .Range("A" & i).Formula = DateSerial(Split(.Range("A" & i).Value, "/")(2), _
                                                 Split(.Range("A" & i).Value, "/")(1), _
                                                 Split(.Range("A" & i).Value, "/")(0))
        Next i

    End With
End Sub

Public Function Sid_SpecialAlt160(s As String)
    Dim counter As Long

    If Len(s) > 0 Then
        counter = Len(s)
        While VBA.Mid(s, counter, 1) = " "
            counter = counter - 1
        Wend
        Sid_SpecialAlt160 = VBA.Mid(s, 1, counter)
    Else
        Sid_SpecialAlt160 = s
    End If
End Function

截图

这篇关于Excel VBA - 日期格式转换的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！