vba 转换多种格式日期
版权声明：本文为博主原创文章，转载请在显著位置标明本文出处以及作者网名，未经作者允许不得用于商业目的。
今天上班的时候需要处理一张表：
需要把里面日期一栏修改为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语句，也许有朋友用得上