[已解决]把不规范日期转成规范日期

datongye

把代码放在按钮里就行了。我想这个对你来说应该很简单了。

cunfu2010

datongye 发表于 2016-3-24 10:00
把代码放在按钮里就行了。我想这个对你来说应该很简单了。

谢谢，我就是提个建议

爱疯

'主程序
Sub conversionDate()
    Dim c, arr, i, x

    '1）初始化
    If Application.FindFile = False Then End
    c = InputBox("日期数据在第几列:", "输入", 1)
    If c <> "" Then c = c * 1 Else End
    arr = Range(Cells(5, c), Cells(Cells(Rows.Count, c).End(3).Row, c))

    '2）转换
    For i = 1 To UBound(arr)
        x = arr(i, 1)
        If Len(x) Then
            If x = val(x) Then x = Number(x) Else x = notNumber(x)
            arr(i, 1) = IIf(x = 0, "", x)
        End If
    Next i

    '3）输出
    Columns(c + 1).NumberFormatLocal = "yyyy/m/d"
    Cells(5, c + 1).Resize(10000) = ""
    Cells(5, c + 1).Resize(i - 1) = arr
End Sub

'数值型
Function Number(x) As Date
    Select Case Len(x)
    Case 5
        Select Case Right(x, 1) * 1
        Case 1 To 9
            Number = Format(x, "0000/0")
        Case Else
            Number = 0    '不处理
        End Select

    Case 6
        Select Case Right(x, 2) * 1
        Case 1 To 11
            Number = Format(x, "0000/00")
        Case 13 To 99
            Number = Format(x, "0000/0/0")
        Case Else
            Number = 0    '不处理
        End Select

    Case 7
        Select Case Mid(x, 5, 2) * 1
        Case 1 To 9
            Number = Format(x, "0000/00/0")
        Case 11, 12
            Number = 0    '不处理
        Case 13 To 99
            '>>> 还需判断最后2位。比如2016132
            Select Case Right(x, 2) * 1
            Case 1 To 31
                Number = Format(x, "0000/0/00")
            Case Else
                Number = 0    '不处理
            End Select
            '<<<
        Case Else
            Number = 0    '不处理
        End Select

    Case 8
        Number = Format(x, "0000/00/00")

    Case Else
        Number = 0    '不处理

    End Select
End Function

'非数值型
Function notNumber(x) As Date
    Dim arr, i
    x = VBA.Replace(x, "日", "")

    arr = Array("年", "月", ".", ",", "。", "、", " ")
    For i = 0 To UBound(arr)
        x = VBA.Replace(x, arr(i), "/")
    Next i

    arr = Array("○", "一", "二", "三", "四", "五", "六", "七", "八", "九", "十")
    For i = 0 To UBound(arr)
        x = VBA.Replace(x, arr(i), i)
    Next i

    arr = Array("零", "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "玖", "拾")
    For i = 0 To UBound(arr)
        x = VBA.Replace(x, arr(i), i)
    Next i

    notNumber = IIf(VBA.IsDate(x), x, 0)
End Function

规范日期格式2.rar (23.47 KB, 下载次数: 15)

2016-3-24 10:30 上传

点击文件名下载附件



1）7位的第5,6位>12时，还需判断第6,7位是否合法。比如，2016132
2）新增：5位的第5位是1到9，则合法。

jiangjane627

那好的

cunfu2010

爱疯 发表于 2016-3-24 10:34
'主程序
Sub conversionDate()
    Dim c, arr, i, x

还是漏了第6、7位的问题了。
另外，如果是6位数的：第5、6位的数据>12的情况必然是月日相连，<=10的情况必然是只有月，设定条件很好判断。=11、=12的情况最会出现两个返回值，遇到这种情况弹出窗口进行选择。这个问题好像没有得到解决

爱疯

cunfu2010 发表于 2016-3-24 10:49
还是漏了第6、7位的问题了。
另外，如果是6位数的：第5、6位的数据>12的情况必然是月日相连，

没漏吧？你加点数据进去试试 。。。。。

如果漏了，再回复是哪种情况的漏了

cunfu2010

爱疯 发表于 2016-3-24 10:54
没漏吧？你加点数据进去试试 。。。。。

如果漏了，再回复是哪种情况的漏了

附件中A34：201611直接转换成了2016/11/1了，还可能是2016/1/11

爱疯

cunfu2010 发表于 2016-3-24 10:58
附件中A34：201611直接转换成了2016/11/1了，还可能是2016/1/11

201611是6位，你能转成7位了，是为什么呢？

cunfu2010

爱疯 发表于 2016-3-24 11:03
201611是6位，你能转成7位了，是为什么呢？

我就是用你给的附件直接转的，就出现这种情况了，是不是默认转成“0000-00-00”格式了？
其实我本来想的就是转成“0000-00-00”格式，因为这种格式是填表时最常用的，相对来说也是最规范的。
6位数的情况，年月后面直接添加“01”作为补充。
7位数的情况，用“0”补充。

爱疯

规范日期格式3.rar (25.05 KB, 下载次数: 11)

2016-3-24 11:11 上传

点击文件名下载附件

6位的处理确实有错误，已修改。