将不同的日期格式统一一种格式（0000/0/0）

cherga

录入的数据 复制到汇总表 时间格式会有出入，有的是2019-1-1 有的是20190101，有的是2019.01.01，有的是文本2019/9/1或者常规格式纯数字43725，如何通过VBA直接统一改为时间格式 2019/1/1这种格式（1-9月份前面不需要加个0）

liulang0808

楼主的问题层出不穷，如果是为了练习，就多看看资料
如果是为了使用，那么就提前做好格式规划，保证数据的规范性

cherga

liulang0808 发表于 2019-10-6 21:49
楼主的问题层出不穷，如果是为了练习，就多看看资料
如果是为了使用，那么就提前做好格式规划，保证数据的 ...

尴尬 最近问题确实有点多 以前是一步一步人工来操作 想着可以用VBA或者函数来一步到位。所以操作过程中有碰到的问题或想法就来论坛搜索，搜索相似的实在不能套用，才求助坛友。另外数据是汇总到我这边，无法能规范所有人的格式（给他们的模版，少部分人发过来的格式都是被打乱或者格式不统一），才出此下策。

风中稻草人

我是觉得，你是做数据汇总，就做好分表格分发出去，分发出去前对表格格式做个统一。不必要后期还处理这个格式问题。这才是正道。个人见解，不喜勿喷！

风中稻草人

格式方面的，分表格可以用数据有效性！这样也有点强制格式的味道。

cherga

风中稻草人 发表于 2019-10-6 22:21
我是觉得，你是做数据汇总，就做好分表格分发出去，分发出去前对表格格式做个统一。不必要后期还处理这个格 ...

有的 分表格式都有弄，就是到个人手上就没办法控制，有的人习惯了这么录 有的不怎么懂Excel的人可能会把格式破坏掉（喜欢复制到其他表格就把格式清除掉） 所以只能到我这边再统一整改。

dushaguo

Sub test() Sheet1.Range("j4:j100").Select  Selection.NumberFormatLocal = "yyyy/m/d;@" data2 = Sheet1.Range("j13").Value   Sheet1.Range("j13").Value = Format$(data2, "Short Date") End Sub

dushaguo

Sub test()
Sheet1.Range("j4:j100").Select

Selection.NumberFormatLocal = "yyyy/m/d;@"
data2 = Sheet1.Range("j13").Value


Sheet1.Range("j13").Value = Format$(data2, "Short Date")
End Sub

这种是文本，错误的日期格式，改不了，手动吧。
其他可以自已加个for

shi353

請將 20190909這種文字日期用手動改成2019/09/09  2019.01.01 手動改成2019/1/1
讓excel知道這是日期的格式資料 這個VBA無法幫忙改!
至於2019-01-01 或數值43725 excel可以識別為日期 不用改!
再執行下面宏
Sub ttt1()
Set A = Sheet1.[J4:J13]
For i = 1 To A.Cells.Count
    With A.Cells(i)
        .Value = Format(.Value, "yyyy/m/d")
    End With
Next
End Sub

liulang0808

Sub changedate()
    r = Cells(Rows.Count, 10).End(3).Row
    Application.ScreenUpdating = False
    arr = Cells(4, 10).Resize(r - 3)
    Cells(4, 10).Resize(r - 3).Clear
    Cells(4, 10).Resize(r - 3).Borders.LineStyle = xlContinuous
    For j = 1 To UBound(arr)
        If Len(arr(j, 1)) > 0 Then
            If Len(arr(j, 1)) < 6 Then
                arr(j, 1) = CDate(arr(j, 1))
            Else
                arr(j, 1) = Replace(Replace(arr(j, 1), ".", "/"), "-", "/")
                If Len(arr(j, 1)) = 8 And InStr(arr(j, 1), "/") = 0 Then
                    arr(j, 1) = Left(arr(j, 1), 4) & "/" & Mid(arr(j, 1), 5, 2) & "/" & Right(arr(j, 1), 2)
                End If
            End If
        End If
    Next j
    Cells(4, 10).Resize(r - 3) = arr
    Application.ScreenUpdating = True
End Sub