将日期格式更改为yyyy-mm-dd。

8
我有一个包含混合格式日期的日期列。例如:

A
21.03.1990
03/21/1990

所以,这一列中有两种不同的格式:dd.mm.yyyy和mm/dd/yyyy。我正在尝试编写一个VBA脚本,将该列中所有日期的格式更改为yyyy-mm-dd。以下是我的代码:
Sub changeFormat()

Dim rLastCell As Range
Dim cell As Range, i As Long
Dim LValue As String

i = 1

With ActiveWorkbook.Worksheets("Sheet1")
    Set rLastCell = .Range("A65536").End(xlUp)
    On Error Resume Next
    For Each cell In .Range("A1:A" & rLastCell.Row)
        LValue = Format(cell.Value, "yyyy-mm-dd")
        .Range("B" & i).Value = LValue
        i = i + 1
    Next cell
    On Error GoTo 0
End With

End Sub

我知道这段代码不太优雅,但我是一个VBA的初学者,请见谅。 这段代码的问题在于它只是将A列无改变地重写到B列,当我将Format函数中的参数从yyyy-mm-dd更改为dd/mm/yyyy时,它可以工作,但仅适用于格式为mm/dd/yyyy的日期,并且保留了格式为dd.mm.yyyy的日期。我会非常感激任何建议。


据我所知,“21.03.1990”不是日期格式,只是以这种方式输入的文本。您能检查单元格格式并确认吗?如果是文本,则更改日期格式对内容没有任何影响。 - Gaijinhunter
在我看来,VBA可能带来的麻烦超出了它的价值。这个任务可以用相当简单的Excel公式完成。 - Jean-François Corbett
6个回答

9

更新:新答案

这里有一个能够解决问题的解决方案!子程序包括一个函数,用于进行替换(这个函数本身非常有用!)。运行该子程序,所有在A列中出现的情况都将被修复。

Sub FixDates()

Dim cell As range
Dim lastRow As Long

lastRow = range("A" & Rows.count).End(xlUp).Row

For Each cell In range("A1:A" & lastRow)
    If InStr(cell.Value, ".") <> 0 Then
        cell.Value = RegexReplace(cell.Value, _
        "(\d{2})\.(\d{2})\.(\d{4})", "$3-$2-$1")
    End If
    If InStr(cell.Value, "/") <> 0 Then
        cell.Value = RegexReplace(cell.Value, _
        "(\d{2})/(\d{2})/(\d{4})", "$3-$1-$2")
    End If
    cell.NumberFormat = "yyyy-mm-d;@"
Next

End Sub 

将此函数放置在相同的模块中:

Function RegexReplace(ByVal text As String, _
                      ByVal replace_what As String, _
                      ByVal replace_with As String) As String

Dim RE As Object
Set RE = CreateObject("vbscript.regexp")

RE.pattern = replace_what
RE.Global = True
RegexReplace = RE.Replace(text, replace_with)

End Function
工作原理:我有一个神奇的RegexReplace函数,可以让您使用正则表达式进行替换。该子程序仅循环遍历您的A列,并为您提到的这两种情况进行正则表达式替换。我首先使用Instr()是为了确定是否需要替换以及需要哪种类型的替换。您可以在技术上跳过这一步,但对不需要替换的单元格进行替换会非常昂贵。最后,为了安全起见,我会将单元格格式化为您的自定义日期格式,而不管其中的内容。

如果您不熟悉Regex(供参考:http://www.regular-expressions.info/ ),我所使用的表达式是:

  • 括号中的每个项目都是捕获组 - 即您想要处理的内容
  • \ d表示数字[0-9]。
  • {2}表示2个,{4}表示4个。为了安全起见,我在这里使用了明确的写法。
  • 在第一个替换中的.之前需要\,因为“.”具有特殊含义。
  • 在VBA正则表达式中,通过使用$ +组编号来引用捕获组。这就是我倒转3个项目顺序的方法。

1
尝试使用IF ISTEXT(cell) AND INSTR(1,cell.text,".")语句,然后将cell.value转换为DATESERIAL(RIGHT(cell.TEXT,4), MID(cell.TEXT,4,2), LEFT(cell.TEXT,2))。这应该将其转换为真正的Excel数据格式,之后您可以应用单元格格式。 - RonnieDickson

4
您不需要使用VBA来完成这个问题。这个单行的工作表公式就可以实现:

=IF(ISERROR(FIND(".",A1)),IF(ISERROR(FIND("/",A1)),"invalid format",
    DATE(RIGHT(A1,4),LEFT(A1,2),MID(A1,4,2))),
    DATE(RIGHT(A1,4),MID(A1,4,2),LEFT(A1,2)))

假设日期和月份总是以两位数给出(例如始终为03而不仅仅是3),年份有四位数(即“限制”在1000-9999年)。但如果这对您不适用,则可以轻松调整公式以适应您的目的。


非常好!我有一个倾向,就是只用VBA编写代码(主要是因为我有一个长公式容易打错的坏习惯),但这是最有效的方法。 - Gaijinhunter

3

看看这个能否满足你的需求。你可能需要为自己的应用程序进行一些调整。

希望这有所帮助!

Sub convertDates()
    Dim rRng As Range
    Dim rCell As Range
    Dim sDest As String
    Dim sYear, sMonth, sDay, aDate

    'Range where the dates are stored, excluding header
    Set rRng = Sheet1.Range("A2:A11")

    'Column name of destination
    sDest = "B"

    'You could also use the following, and just select the range.
    'Set rRng = Application.selection

    For Each rCell In rRng.Cells
        sYear = 99999

        If InStr(rCell.Value, ".") > 0 Then
            aDate = Split(rCell.Value, ".")
            If UBound(aDate) = 2 Then
                sDay = aDate(0)
                sMonth = aDate(1)
                sYear = aDate(2)
            End If
        ElseIf InStr(rCell.Value, "/") > 0 Then
            aDate = Split(rCell.Value, "/")
            If UBound(aDate) = 2 Then
                sDay = aDate(1)
                sMonth = aDate(0)
                sYear = aDate(2)
            End If
        End If

        With rCell.Range(sDest & "1")
            If sYear <> 99999 Then
                On Error Resume Next
                .Value = "'" & Format(CDate(sMonth & "/" & sDay & "/" & sYear), "YYYY-MM-DD")
                'If it can't convert the date, just put the original value in the dest
                'cell. You can tailor this to your own preference.
                If Err.Number <> 0 Then .Value = rCell.Value
                On Error GoTo 0
            Else
                .Value = rCell.Value
            End If
        End With
    Next
End Sub

1
@Jean-François Corbett有一个公式解决方案可用,但如果放弃错误消息(因为#VALUE!已足够说明问题),并且使用另一个IF(两个日期),应用IFERROR而不是ISERROR,并用SUBSTITUTE代替LEFT,MID,RIGHT一组,则该解决方案可能缩短超过一半。
=IFERROR(1*(MID(A1,4,3)&LEFT(A1,3)&RIGHT(A1,4)),1*SUBSTITUTE(A1,".","/"))

这适用于@Issun在评论中提到的解释,并假定输出将格式化为yyyy-mm-dd单元格。可以像下面这样使用子程序编写:
Sub Macro1()
Range("B1:B10").Formula = "=IFERROR(1*(MID(A1,4,3)&LEFT(A1,3)&RIGHT(A1,4)),1*SUBSTITUTE(A1,""."",""/""))"
End Sub  

0

这里有一个简单的解决方案:

     Sub ChangeFormat1()

              Dim ws as Worksheet
                 Set ws = Thisworkbook.Sheets("Sheet1")
                 LR = ws.cells(rows.count,1).End(Xlup).Row

                 with ws
                        For I = 1 to LR
                          .cells(I,2).value = .cells(I,1).value
                        Next
                 End with

                 ws.range("B1:B" & LR).numberformat = "yyyy-mm-dd"
      End Sub

-1

Month(Date) & "-" & Day(Date) & "-" & Year(Date)

月份(日期)&“-”&日期(日期)&“-”&年份(日期)


网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接