VBA查找和替换中断日期格式

时间:2015-01-20 03:11:15

标签: excel vba date excel-vba

我正在尝试将SAP数据从日期格式--dd.mm.yyyy转换为excel日期格式,以便我可以将其从最旧到最新排序。

我目前有当前的代码来执行此操作但是有一个错误似乎是由查找和替换代码创建自己的数字格式导致任何格式应用程序在其使用之前和之后毫无意义,因为它将始终将任何日期转换为尽可能采用美国格式:

01.02.2015 - > 2015年2月1日而不是01/02/2015。 dd.mm.yyyy - > mm.dd.yyyy而不是dd.mm.yyyy

当然后尝试更改格式时,似乎有dd& mm字段由于我尝试格式化而无法交换,因为只有部分数据受此影响,因为某些日期不适合此范围,而且似乎只是保持静态格式。

是否有办法绕过这个或另一种查找和替换此数据的方法?我在这里看到了类似的替换常量的选项,但它们都不适用于我或者是我可以使用的。我无法在日期列旁边输入新列,因为这是直接从SAP粘贴的数据。

我一直在使用的代码如下:

' Change Release Date to date format
Sheets("Article List").Select
Last = LastRow(ActiveSheet)
range("K4:K" & Last).Select
Selection.Replace _
    What:=".", _
    Replacement:="/", _
    LookAt:=xlPart, _
    SearchOrder:=xlByRows, _
    MatchCase:=False, _
    SearchFormat:=False, _
    ReplaceFormat:=False
Selection.NumberFormat = "dd/mm/yyyy"

然后使用vlookup将格式化后的数据复制到我的主数据表中,它应该保持与使用自定义格式dd / mm / yyyy设置的格式相同的格式。

当手动处理数据时,我能够使用查找和替换它给出正确的结果 - 它使用与上面相同的代码,通过尝试在故障排除期间记录宏来确认。

希望有人在这里可能会有一些关于如何继续的建议。

非常感谢,

4 个答案:

答案 0 :(得分:0)

假设您的LastRow()返回Long,请尝试以下操作:

Private Function MDY2DMY(oRng As Range) As Date
    Dim oMDY As Variant, dDMY As Date
    oMDY = Split(Trim(oRng.Value), ".")
    dDMY = DateSerial(oMDY(2), oMDY(0), oMDY(1))
    MDY2DMY = dDMY
End Function

Sub ChangeMDY2DMY()
    Dim oWS As Worksheet, Last As Long, oRng As Range, dDMY As Date

    Set oWS = ActiveSheet
    Last = LastRow(oWS)
    Set oRng = oWS.Range("K4")
    Do
        If oRng.NumberFormat <> "dd/mm/yyyy" Then
            dDMY = MDY2DMY(oRng) ' Get the date value from M.D.Y. format
            oRng.NumberFormat = "dd/mm/yyyy" ' Change the number format
            oRng.Value = dDMY ' Change the value
        End If
        Set oRng = oRng.Offset(1) ' Move down 1 row
    Loop Until oRng.Row > Last
    Set oRng = Nothing
    Set oWS = Nothing
End Sub

已添加代码以防止在单元格上再次运行。

答案 1 :(得分:0)

我花了大约两个小时在谷歌搜索这个问题的答案,而我唯一能将日期转换为正斜杠dd / mm / yyyy格式的VBA函数是TextToColumns函数。

Sub CleanDate()
Dim LastRow As Long

Sheets("Article List").Select
LastRow = ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, 
LookIn:=xlValues, _
SearchDirection:=xlPrevious).Row
Range("K4", Cells(LastRow, "K")).Select

Range("K4:K" & LastRow).TextToColumns Destination:=Range("K4"), 
DataType:=xlDelimited, _
FieldInfo:=Array(1, xlDMYFormat)

End Sub

我从这个页面得到了这个想法 - https://social.msdn.microsoft.com/Forums/en-US/e3522eac-13b1-476c-8766-d70794131cc8/strange-date-conversion-while-using-vba-replace-function?forum=isvvba

答案 2 :(得分:0)

有效行:

 Selection.Replace _
 What: = ".", _
 Replacement: = "/",
 ....

执行错误的更改操作。仅当原始日期的日期大于12时才有效。在这种情况下,代码会完美地执行 替换

为避免此问题,解决方案是在文本模式下格式化单元格,并对每个单元格执行 ,并使用 替换

此代码完美运行。

Private Sub f_MyFunction()
    'Obligatory so that it does not travel the entire column
    Range("K4", "K" & Range("K4").End(xlDown).Row).Select

   'Obligatory so that Excel does not swap ddmm-> mmdd
    Selection.NumberFormat = "@"

    'This method does not generate swap errors
    For Each obj_cell In Selection.Cells
        With obj_cell
            If IsNull(obj_cell) Then Exit Sub
            obj_cell.Value = Replace(.Text, ".", "/")
        End With
    Next
    'And now change the format to DATE
    Selection.NumberFormat = "mm/dd/yyyy;@"
End Sub

答案 3 :(得分:0)

我继续进行调查,发现了另一种可以立即进行更改的方法,尽管该更改的格式为 dd / mm / yyyy 。如果要将'/'更改为'-',则必须使用 对于每个人 方法和 替换 在我之前的答案中提到过。

另一种方法使用 Range.TextToColumns FieldInfo参数:=数组(0,xlDMYFormat)

这很了不起,但这只是一行。此外,该单元格不仅按日期设置格式,而且允许使用任何字符作为日期分隔符。

'From K4 to last row
Range("K4", "K" & Range("K4").End(xlDown).Row).TextToColumns FieldInfo:=Array(0, xlDMYFormat)
'1.2.2019 -> 01/02/2019
'1_2_2019 -> 01/02/2019
'1*2*2019 -> 01/02/2019...

'To do it over only one cell
Range("A1").TextToColumns FieldInfo:=Array(0, xlDMYFormat)