Question

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

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

然而，我的细胞都没有填充，任何帮助都会非常感激。

提前致谢

Answer 1

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

Excel VBA插入日期，单元格空白

1 个答案: