使用DateSerial的VBA在范围内的空白单元格处停止

时间:2017-10-06 14:09:47

标签: vba date-formatting

我有一些vba代码可以评估6列,并将日期从yyyymmdd格式化为mm / dd / yyyy。代码工作正常,直到它在范围内找到一个空白单元格然后我得到类型13运行时错误。调试器突出显示DateSerial行,所以我假设我的问题出在那里。

有什么想法吗?

Sub Convert_Date()
    Dim c As Range
    Application.ScreenUpdating = False
    For Each c In Range("AC2:AC" & Cells(Rows.Count, "AC").End(xlUp).Row)
        c.Value = DateSerial(Left(c.Value, 4), Mid(c.Value, 5, 2), Right(c.Value, 2))
        c.NumberFormat = "mm/dd/yyyy"
    Next
    Application.ScreenUpdating = False

     Dim b As Range
    Application.ScreenUpdating = False
    For Each b In Range("AL2:AL" & Cells(Rows.Count, "AL").End(xlUp).Row)
        b.Value = DateSerial(Left(b.Value, 4), Mid(b.Value, 5, 2), Right(b.Value, 2))
        b.NumberFormat = "mm/dd/yyyy"
    Next
    Application.ScreenUpdating = False

      Dim a As Range
    Application.ScreenUpdating = False
    For Each a In Range("AQ2:AQ" & Cells(Rows.Count, "A").End(xlUp).Row)
        a.Value = DateSerial(Left(a.Value, 4), Mid(a.Value, 5, 2), Right(a.Value, 2))
        a.NumberFormat = "mm/yyyy"
    Next
    Application.ScreenUpdating = False

    Dim d As Range
    Application.ScreenUpdating = False
    For Each d In Range("AR2:AR" & Cells(Rows.Count, "A").End(xlUp).Row)
        d.Value = DateSerial(Left(d.Value, 4), Mid(d.Value, 5, 2), Right(d.Value, 2))
        d.NumberFormat = "mm/yyyy"
    Next
    Application.ScreenUpdating = False

    Dim e As Range
    Application.ScreenUpdating = False
    For Each e In Range("AT2:AT" & Cells(Rows.Count, "A").End(xlUp).Row)
        e.Value = DateSerial(Left(e.Value, 4), Mid(e.Value, 5, 2), Right(e.Value, 2))
        e.NumberFormat = "mm/yyyy"
    Next
    Application.ScreenUpdating = False

     Dim f As Range
    Application.ScreenUpdating = False
    For Each f In Range("AU2:AU" & Cells(Rows.Count, "A").End(xlUp).Row)
        f.Value = DateSerial(Left(f.Value, 4), Mid(f.Value, 5, 2), Right(f.Value, 2))
        f.NumberFormat = "mm/yyyy"
    Next
    Application.ScreenUpdating = False


End Sub

1 个答案:

答案 0 :(得分:0)

尝试检查每个条件,值是否为空。像这样:

If Not IsEmpty(c) then
    c.Value = DateSerial(Left(c.Value, 4), Mid(c.Value, 5, 2), Right(c.Value, 2))
    c.NumberFormat = "mm/dd/yyyy"
End If

一旦深入了解VBA,您可以开始使用这样的函数:

Sub Convert_Date()

    Application.ScreenUpdating = False

    RockAndRoll "AC2:AC", "AC"
    Call RockAndRoll ("AR2:AR", "A")
    RockAndRoll "AL2:AL", "AC"
    'RockAndRoll etc...
    Application.ScreenUpdating = True

End Sub

Public Sub RockAndRoll(myLeft As String, myRight As String)

    Dim a As Range

    With ActiveSheet
        For Each a In .Range(myLeft & .Cells(.Rows.Count, myRight).End(xlUp).Row)
            If Not IsEmpty(a) Then
                a.value = DateSerial(Left(a.value, 4), Mid(a.value, 5, 2), Right(a.value, 2))
                a.NumberFormat = "mm/yyyy"
            End If
        Next
    End With

End Sub

所以你不应该一遍又一遍地重复这些代码。