Excel VBA If Then Else loss date format на первом листе в графе

Question

Я написал несколько Excel VBA, чтобы добавить даты дня недели, вниз столбец «A», для 41 рабочего листа. Даты строятся до 90 дней, а затем имеют значение «Beyond mm/dd/yy» в следующей ячейке. Код запускается каждый будний день, за исключением праздников, и строит даты по ячейке, которая ранее была текстовой ячейкой. Этот процесс прекрасно работает, за исключением первого из 41 листа, где добавленная дата (ы) отображается в виде текста, хотя их «формат» будет указывать, что они являются датой. Остальные 40 отображаются как даты. Я попытался завернуть свои расчетные даты в CDate() и DateValue(), и то и другое. Закрытие, которое я пришло, было копирование по указанной ячейке, но затем я получу не-будни, так как Excel создает следующий автозаполнение. Я даже попытался вернуться к одному листу с проблемой и снова пропустить IF Then Else, но с определенным значением для строки «Beyond» и затем переназначить даты - это дало тот же результат; поэтому я пришел к выводу, что проблема, вероятно, связана с тем, как я написал IF, затем 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 date formats. Я не интегрировал решение, чтобы предотвратить возникновение этого события, в рамках моего 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