Excel VBA If Then Else Count中第一个工作表上的丢失日期格式

Question

我已经写了一些Excel VBA来为41个工作表添加工作日日期，在列“ A”下。 日期建立到90天，然后在下面的单元格中具有“超出mm / dd / yy”的文本值。 该代码在每个工作日（节假日除外）运行，并在以前为文本单元格的单元格上构建日期。 除了41个工作表中的第一个工作表（该工作表中的第一个工作表中添加的日期以文本形式显示）外，该过程的运行效果非常好，即使它们的“格式”将其表示为日期。 其他40个显示为日期。 我试图将计算出的日期包装在CDate（）和DateValue（）两者中。 我关闭的时间是复制上面的单元格，但是由于Excel构建了下一个自动填充功能，因此我将获得非工作日。 我什至试图重新讨论一个有问题的工作表，并再次浏览IF然后Else，但是，为“ Beyond”文本行定义了一个值，然后重新分配了日期-这产生了相同的结果； 因此，我得出的结论是，该问题可能与我如何编写IF Then Else部分有关。

谢谢你的想法〜

Dim count As Integer
Sheets("ABCD").Activate


For count = 1 To 41


'***************************************************************************    ********************
'Inserts Dates for weekdays, until 90 days out, then a "Beyond       MM/DD/YY"     value for the last date
'***********************************************************************************************

Dim ThisSheet As String

'turn off auto formula calculation
Application.Calculation = xlManual

Range("A1").Activate

'find the current "Beyond" date cell
Columns("A:A").Select
Selection.Find(What:="Beyond", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate

Range("A" & ActiveCell.Row).Select

'Add business days to column(A:A) until the next business day would be 91 days or greater
Do Until ((Weekday(Range("A" & ActiveCell.Row - 1)) = 6) And _
(DateAdd("w", 3, Range("A" & ActiveCell.Row - 1))) >= (DateAdd("d", 91, Date))) Or _
((Weekday(Range("A" & ActiveCell.Row - 1)) <> 6) And _
(DateAdd("d", 1, Range("A" & ActiveCell.Row - 1))) >= (DateAdd("d", 91, Date)))

    If Weekday(Range("A" & ActiveCell.Row - 1)) = 6 Then
        ActiveCell.NumberFormat = "m/d/yyyy"
        ActiveCell.Value = DateValue(DateAdd("w", 3, Range("A" & (ActiveCell.Row - 1))))
        Selection.NumberFormat = "m/d/yyyy"

    ElseIf Weekday(Range("A" & ActiveCell.Row - 1)) = 7 Then
            ActiveCell.NumberFormat = "m/d/yyyy"
            ActiveCell.Value = DateValue(DateAdd("w", 2, Range("A" & (ActiveCell.Row - 1))))
            ActiveCell.Select
            Selection.NumberFormat = "m/d/yyyy"

    Else: ActiveCell.NumberFormat = "m/d/yyyy"
            ActiveCell.Value = DateValue(DateAdd("w", 1, Range("A" & (ActiveCell.Row - 1))))
            ActiveCell.Select
            Selection.NumberFormat = "m/d/yyyy"

    End If

    Selection.Offset(1, 0).Activate

Loop


'Add in the "Beyond" date, to column(A:A)
ActiveCell.Value = "Beyond " & Format((DateAdd("d", 90, Date)), "mm/dd/yy")

Range("A1").Select
'*****************************************************************************************


'****************************************************************
'Copies down formulas to the last date or "Beyond MM/DD/YYYY" row
'****************************************************************

'Set LastRow Value for end of desired formula range
LTCashSheet_LastRow = Range("A" & Rows.count).End(xlUp).Row

'Set LastRow Value for beginning formulas to copy down
LTCashSheet_BegCopyRange = Range("B" & Rows.count).End(xlUp).Row

    Range("B" & LTCashSheet_BegCopyRange & ":N" & LTCashSheet_BegCopyRange).Select
    Selection.AutoFill Destination:=Range("B" & LTCashSheet_BegCopyRange & ":N" & LTCashSheet_LastRow), Type:=xlFillDefault
    Range("B" & LTCashSheet_BegCopyRange & ":N" & LTCashSheet_LastRow).Select

Columns("A:A").AutoFit
'****************************************************************


'****************************************************************
'Hide Rows 11 through rows prior to today's date row*************
'****************************************************************
Set TheRng = Range("A1", Range("A" & Rows.count).End(xlUp))
CurrDtRow = TheRng.Find(What:=Date, LookAt:=xlWhole).Row
    Rows("11:" & (CurrDtRow - 2)).Select
    Selection.EntireRow.Hidden = True

Range("A1").Select
'****************************************************************


'Go to next sheet and repeat, through 'count'********************
ActiveSheet.Next.Select

Next count

Answer 1

我从Excel VBA日期格式中找到了有用的信息。 我没有在IF THEN ELSE内集成解决方案来防止上述情况的发生； 但是，我能够使用该函数添加一些清理功能，并将代码应用到“ Beyond”值正上方的单元格中，这些单元格是String和Date的奇怪混合体。 我很高兴，但是，如果您认为我应该走另外一条路，请随时发表评论。

谢谢！

Function CellContentCanBeInterpretedAsADate(cell As Range) As Boolean
    Dim d As Date
    On Error Resume Next
    d = CDate(cell.Value)
    If Err.Number <> 0 Then
        CellContentCanBeInterpretedAsADate = False
    Else
        CellContentCanBeInterpretedAsADate = True
    End If
    On Error GoTo 0
End Function

Sub FixDtFrmtWithFnctn()

Dim cell As Range
Dim cvalue As Double

Sheets("NCE1").Select

Set TheRng4 = Range("A1", Range("A" & Rows.count).End(xlUp))
DtFrmtFixRow = TheRng4.Find(What:=("Beyond"), LookAt:=xlPart).Row

Set cell = Range("A" & (DtFrmtFixRow - 1))

If CellContentCanBeInterpretedAsADate(cell) Then
    cvalue = CDate(cell.Value)
    cell.Value = cvalue
    cell.NumberFormat = "m/d/yyyy"
Else
    cell.NumberFormat = "General"
End If

Set cell = Range("A" & (DtFrmtFixRow - 2))

If CellContentCanBeInterpretedAsADate(cell) Then
    cvalue = CDate(cell.Value)
    cell.Value = cvalue
    cell.NumberFormat = "m/d/yyyy"
Else
    cell.NumberFormat = "General"
End If

Set cell = Range("A" & (DtFrmtFixRow - 3))

If CellContentCanBeInterpretedAsADate(cell) Then
    cvalue = CDate(cell.Value)
    cell.Value = cvalue
    cell.NumberFormat = "m/d/yyyy"
Else
    cell.NumberFormat = "General"
End If

End Sub