ExcelVBA插入单元格空白的日期

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