vba 转换多种格式日期

Posted 2022-06-04 VB.Net

版权声明：本文为博主原创文章，转载请在显著位置标明本文出处以及作者网名，未经作者允许不得用于商业目的。

今天上班的时候需要处理一张表：

需要把里面日期一栏修改为yyyymmdd形式，表中的日期数据也就是有三种
1、2019/1/9，但是设置了单元格的日期格式，显示为2019年1月9日，如第1行。
2、2017年6月20日，直接就是文本的2017年6月20日，如第14行。
3、2017.2.23，如第18行
三种日期数据格式在原表中交错的，总共有几千行，如果只有那20几行我也就手动修改了，几千行太累了，只有祭出vba了。
按照这三种不同的数据分别处理即可：

Sub ??1()
'
' ??1 ??
'
Dim i As Integer
Dim fsrq As String
Dim fsrq2 As String

Dim pos1 As Integer
Dim pos2 As Integer
Dim pos3 As Integer

Dim y As String
Dim m As String
Dim d As String

For i = 1 To 26
    fsrq = Sheets("sheet1").Range("E" & i).Value
    If InStr(fsrq, "??") Then
         pos1 = InStr(fsrq, "??")
         pos2 = InStr(fsrq, "??")
         pos3 = InStr(fsrq, "??")
    
        y = Left(fsrq, pos1 - 1)
        m = Mid(fsrq, pos1 + 1, pos2 - pos1 - 1)
        d = Mid(fsrq, pos2 + 1, pos3 - pos2 - 1)
        
        If Len(m) = 1 Then m = "0" & m
        If Len(d) = 1 Then d = "0" & d
        
        fsrq2 = y & m & d
    ElseIf InStr(fsrq, ".") Then
        pos1 = InStr(fsrq, ".")
        pos2 = InStr(pos1 + 1, fsrq, ".")
    
        y = Left(fsrq, pos1 - 1)
        m = Mid(fsrq, pos1 + 1, pos2 - pos1 - 1)
        d = Right(fsrq, Len(fsrq) - pos2)
        
        If Len(m) = 1 Then m = "0" & m
        If Len(d) = 1 Then d = "0" & d
        
        fsrq2 = y & m & d
    Else
        fsrq = Format(fsrq, "yyyymmdd")
        fsrq2 = Replace(fsrq, "/", "")
    End If
     Sheets("sheet1").Range("F" & i).Value = fsrq2
Next
'
End Sub

运行后的效果：

可见格式如 2019/1/9 的数据显示有问题。如果双击########的数据，也会显示正确：

显然不是我们需要的，查看单元格格式，可以看到excel把这项仍然处理为日期，这时候想起我之前删除的F列也是日期。
如果用现在的代码，那么两个方法可以解决：1、将F列先修改格式为文本；2、删除F列，这样新的F列就没有日期格式。然后在运行代码。
当然我们更可以直接用代码解决，修改后的代码如下：

Sub ??1()
'
' ??1 ??
'
Dim i As Integer
Dim fsrq As String
Dim fsrq2 As String

Dim pos1 As Integer
Dim pos2 As Integer
Dim pos3 As Integer

Dim y As String
Dim m As String
Dim d As String

For i = 1 To 26
    fsrq = Sheets("sheet1").Range("E" & i).Value
    If InStr(fsrq, "??") Then
         pos1 = InStr(fsrq, "??")
         pos2 = InStr(fsrq, "??")
         pos3 = InStr(fsrq, "??")
    
        y = Left(fsrq, pos1 - 1)
        m = Mid(fsrq, pos1 + 1, pos2 - pos1 - 1)
        d = Mid(fsrq, pos2 + 1, pos3 - pos2 - 1)
        
        If Len(m) = 1 Then m = "0" & m
        If Len(d) = 1 Then d = "0" & d
        
        fsrq2 = y & m & d
    ElseIf InStr(fsrq, ".") Then
        pos1 = InStr(fsrq, ".")
        pos2 = InStr(pos1 + 1, fsrq, ".")
    
        y = Left(fsrq, pos1 - 1)
        m = Mid(fsrq, pos1 + 1, pos2 - pos1 - 1)
        d = Right(fsrq, Len(fsrq) - pos2)
        
        If Len(m) = 1 Then m = "0" & m
        If Len(d) = 1 Then d = "0" & d
        
        fsrq2 = y & m & d
    Else
        fsrq = Format(fsrq, "yyyymmdd")
        fsrq2 = Replace(fsrq, "/", "")
    End If
     Sheets("sheet1").Range("F" & i).NumberFormatLocal = "@"
     Sheets("sheet1").Range("F" & i).Value = fsrq2
Next
'
End Sub

只需要添加一行代码： Sheets("sheet1").Range("F" & i).NumberFormatLocal = "@"，让单元格格式为文本。
所有日期都可以转换成功了，运行后如下：


都是简单的vba语句，也许有朋友用得上