时间戳

首页 > 解决方案 > Excel VBA在单元格空白处插入日期

excel - Excel VBA在单元格空白处插入日期

问题描述

我在电子表格中有一个列，其中填充了日期信息，就目前而言，它只给了我一年。为了正确阅读它，我需要将信息重新格式化为正确的日期格式，因此我尝试执行以下操作：

With ActiveSheet
    RowCount = WorksheetFunction.CountA(Range("A5", Range("A5").End(xlDown)))
End With

  For k = 1 To RowCount

      If ActiveCell.Range(15, k + 1).Value = "" Then
            ActiveCell.Range(15, k + 1).Value = "01/01/9999"
        Else
            ActiveSheet.Range(15, k + 1).Value = "01/01/" & ActiveSheet.Range(15, k + 1).Value
        End If

Next k

然而，我的细胞都没有填充，任何帮助将不胜感激。

提前致谢

标签： excelvba

解决方案

RowCount可能返回不正确的计数。

日期作为数字存储在单元格中 - 只需添加01/01/它就可以了，但是会出现很多可能的错误。例如，如果一个单元格包含SO，它会很乐意将其转换为01/01/SO。

您的第一次运行可能会返回正确的值，例如01/01/2018和不正确的值，例如01/01/SO. 再次运行它，代码会很高兴地给你01/01/01/01/2018，01/01/01/01/SO因为它只是01/01/每次都添加到前面。

我建议不要仅仅增加值，如果可以的话，将 01/01/年份转换为实际日期。DateSerial

Sub TurnToDate()

    Dim wrkSht As Worksheet
    Dim lLastRow As Long
    Dim k As Long

    On Error GoTo Err_Handle

    Set wrkSht = ThisWorkbook.Worksheets("Sheet1")
    lLastRow = wrkSht.Cells(wrkSht.Rows.Count, 1).End(xlUp).Row

    With wrkSht
        For k = 1 To lLastRow
            If .Cells(k, 1) = "" Then
                .Cells(k, 1) = DateSerial(9999, 1, 1)
            Else
                'Overflow or type mismatch errors may occur here.
               .Cells(k, 1) = DateSerial(.Cells(k, 1), 1, 1)
            End If
        Next k
    End With

Exit Sub

Err_Handle:

    Select Case Err.Number
        Case 13, 6 '13 = Type Mismatch, 6 = Overflow
            'Occurs if text or date already exists in cell.
            'Clears the error and resumes execution on line following error.
            Resume Next
        Case Else
            MsgBox Err.Description, vbOKOnly, Err.Number
    End Select

End Sub

推荐阅读