Excel VBA如果那么在第一张工作表中丢失日期格式

Question

我已经写了一些Excel VBA来为41个工作表添加工作日日期，向下列“A”。日期生成为90天，然后在下面的单元格中具有“超越mm/dd/yy”文本值。该代码每个工作日都会运行，除了假期之外，还会在之前为文本单元格的单元格上创建日期。这个过程非常漂亮，除了41个工作表中的第一个，其中添加的日期显示为文本，即使他们的“格式”会表示它们是日期。另外40个显示为日期。我试图将我的计算日期包裹在CDate（）和DateValue（）中，以及两者。我收到的结果是复制了上面的单元格，但随后我将得到非平日，因为Excel将构建下一个自动填充。我甚至试图用问题重新审视一个工作表，然后再遍历IF Then Else，但是，为“超越”文本行定义了一个值，然后重新指定了日期 - 这产生了相同的结果;所以，我的结论是，这个问题可能与我如何编写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 date formats有用的信息。我没有整合解决方案来防止上述情况发生，在我的IF THEELSE中;然而，我能够使用该函数添加一些清理工作，并将代码应用到“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