插入缺失数据，然后将数据添加到前两列 A 和 B

Question

下面是一个 VBA，在启动时我收到错误代码“运行时错误 '13：类型不匹配”。 以前它在通用格式“dd mmm yyyy hhmm”上工作得很好。在使用其他几个 VBA 之后，它现在采用自定义格式“dd mmm yyyy hhmm”。最终目标是在跳过日期的地方插入一个空白行，并在 A 列的空白行中放置“NO DEPARTURS”，对于 B 列和 C 列有“N/A”，对于 D 列输入“dd mmm yyyy 0000”中缺少日期。调试时以 d1= cdate... 开头的行突出显示。

Sub Missing_date()
Dim d1 As Date, d2 As Date

r = 1
start:

If Cells(r + 1, "D") = "" Then Exit Sub

d1 = CDate(Split(Cells(r, "D"), " ")(1) & ", " & Split(Cells(r, "D"), " ")(0) & " " & Split(Cells(r, "D"), " ")(2))
d2 = CDate(Split(Cells(r + 1, "D"), " ")(1) & ", " & Split(Cells(r + 1, "D"), " ")(0) & " " & Split(Cells(r + 1, "D"), " ")(2))

If d2 - d1 >= 2 Then
    Rows(r + 1).Insert shift:=xlDown
    Cells(r + 1, "D") = Format(d1 + 1, "dd mmm yyyy 0000")
    Cells(r + 1, "A") = "NO DEPARTURES"
    Cells(r + 1, "B") = "N/A"
    Cells(r + 1, "C") = "N/A"
End If

r = r + 1
GoTo start

End Sub

Answer 1

尝试以自己的方式而不是 Excel 想要的方式处理日期会遇到很多麻烦。我冒昧地假设您无意向 Excel 宣战。请尝试此代码。

Option Explicit

Sub InsertMissingDates()
    ' 111
    
    Dim NextDate    As Variant
    Dim CellVal     As Variant
    Dim R           As Long                     ' loop counter: Rows
    
    R = Cells(Rows.Count, "D").End(xlUp).Row
    NextDate = CellDate(Cells(R, "D"))
    If NextDate = vbError Then Exit Sub
    
    ' bottom rows must be inserted before top rows
    For R = R - 1 To 2 Step -1
        CellVal = CellDate(Cells(R, "D"))
        If CellVal = vbError Then Exit For       ' exit if date can't be recognised
        
        Do While Int(CDbl(CellVal)) < Int(CDbl(NextDate - 1))
            Rows(R + 1).Insert Shift:=xlDown
            With Cells(R + 1, "D")
                .Value = Int(CDbl(NextDate - 1))
                .NumberFormat = "dd mmm yyyy hhmm"
                .HorizontalAlignment = xlLeft
            End With
            Cells(R + 1, "A").Value = "NO DEPARTURES"
            Cells(R + 1, "B").Value = "N/A"
            Cells(R + 1, "C").Value = "N/A"
            NextDate = NextDate - 1
        Loop
        NextDate = CellVal
    Next R
End Sub

Private Function CellDate(Cell As Range) As Variant
    ' 111
    ' return vbError if cell's value couldn't be converted to a date
    
    Dim Fun         As Variant              ' function return value
    Dim CellVal     As Variant
    Dim Sp()        As String
    
    CellVal = Cell.Value
    If IsDate(CellVal) Then
        Fun = CDate(CellVal)
    Else
        Sp = Split(CellVal, " ")
            
        If UBound(Sp) = 3 Then
            Sp(3) = Right("0000" & Sp(3), 4)
            Sp(3) = Left(Sp(3), 2) & ":" & Right(Sp(3), 2)
            On Error Resume Next
            Fun = CDate(Join(Sp))
        End If
    End If
    If VarType(Fun) <> vbDate Then
            MsgBox """" & CellVal & """ in row " & Cell.Row & vbCr & _
                   "couldn't be converted to a date.", _
                   vbInformation, "Data format error"
            Fun = vbError
    End If
    CellDate = Fun
End Function

关键是 Excel 将日期视为整数，例如 44135。明天将是 44136。因此每天 = 1，因此每小时 = 1/24。 44135.0 是上午 12 点，43135.5 表示中午 12 点。要显示这些数字，例如 2020 年 10 月 31 日 1200，您无需格式化数字，而是格式化单元格。这就是我的代码所做的。

现在您的工作表中将有单元格，其中包含看起来像日期的文本（您的条目）和看起来像文本的日期（由我的代码创建的条目）。考虑编写一个程序，查看每个单元格的NumberFormat，如果它是文本，则将其值更改为适当的日期，同时应用所需的格式。您可以使用我上述过程中的代码行将它们组合在一起。然后函数CellDate 将变得过时，因为它的唯一工作是在您的文本日期和 Excel 的意图之间进行调解。