Vba excel上的日期格式问题

您好，我有一个宏问题，它从一个工作簿复制信息并粘贴到另一个工作簿。然后它创建两列，并用IF公式填充它们以比较两个日期。这些公式带来了错误的结果，因为其中一列有另一个日期格式，我无法更改它，我对单元格所做的任何操作都不起作用，只有删除该列任何单元格上的值并写入日期，我才能更改格式

所需的主要格式是YYYY-MM-DD，但此列设置为DD/MM/YYYY，即使我更新单元格并将其设置为日期或自定义，它也无法正常工作，它始终显示错误的格式

这就是我正在研究的宏，有什么办法解决这个问题吗

先谢谢你

    Sub AD_Audit()

'Last cell in column
Dim ws As Worksheet
Dim LastCell As Range
Dim LastCellRowNumber As Long
Dim wb3 As Workbook

Set ws = Worksheets(2)
With ws
    Set LastCell = .Cells(.Rows.Count, "A").End(xlUp)
    LastCellRowNumber = LastCell.Row + 1
End With

Dim Wb As Workbook, wb2 As Workbook
Dim vFile As Variant

'Set source workbook
Set Wb = ActiveWorkbook

'Open the target workbook
vFile = Application.GetOpenFilename("Excel-files,*.xlsx", _
    1, "Select One File To Open", , False)

'if the user didn't select a file, exit sub
If TypeName(vFile) = "Boolean" Then Exit Sub
Workbooks.Open vFile

'Set selectedworkbook
Set wb2 = ActiveWorkbook

'Select cells to copy
wb2.Worksheets(2).Range("A1:BD" & ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row).Select
Selection.Copy

'Go back to original workbook you want to paste into
Wb.Activate

'Paste starting at the last empty row
Wb.Worksheets(2).Activate
Wb.Worksheets(2).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
  Application.CutCopyMode = False
Application.ScreenUpdating = True

Dim LstrDate As String
Dim LDate As Date

LstrDate = "Apr 6, 2003"
LDate = CDate(LstrDate)

'search for columns containing the data needed
Dim x As Integer
Dim lastRow As Long
lastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row


Dim rFind As Range
With Range("A:DB")
        Set rFind = .Find(What:="Account Last Updated", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
        If Not rFind Is Nothing Then
End If
End With

 Dim rFind1 As Range

    With Range("A:DB")
        Set rFind1 = .Find(What:="Termination Date", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
        If Not rFind1 Is Nothing Then

        End If
    End With

    Dim rFind2 As Range

    With Range("A:DB")
        Set rFind2 = .Find(What:="Last Password set date", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
        If Not rFind2 Is Nothing Then
        End If
    End With

'create columns and fill them with formulas
x = ActiveSheet.UsedRange.Columns.Count
ActiveSheet.Cells(1, x + 1) = "Account last updated after termination"
intcounter = 2
While (intcounter <= lastRow)
    ActiveSheet.Cells(intcounter, x + 1).Formula = "=IF(TEXT(""" & Cells(intcounter, rFind.Column) & """,""YYYY/MM/DD"")>=TEXT(""" & Cells(intcounter, rFind1.Column) & """,""YYYY/MM/DD""),""review"",""disabled"")"
    intcounter = intcounter + 1
Wend


x = ActiveSheet.UsedRange.Columns.Count
ActiveSheet.Cells(1, x + 1) = "Password After Termination"
intcounter = 2
While (intcounter <= lastRow)
    ActiveSheet.Cells(intcounter, x + 1).Formula = "=IF(TEXT(""" & Cells(intcounter, rFind2.Column) & """,""YYYY/MM/DD"")>=TEXT(""" & Cells(intcounter, rFind1.Column) & """,""YYYY/MM/DD""),""review"",""old"")"
    intcounter = intcounter + 1
Wend

'add column Actions
Worksheets(2).Range("A1").EntireColumn.Insert
Worksheets(2).Range("A1").Formula = "Actions"

'Set headers to bold text
Rows(1).Font.Bold = True


'check for filter, turn on if none exists
  If Not ActiveSheet.AutoFilterMode Then
    ActiveSheet.Range("A1:BD1").AutoFilter
  End If
  Dim Notes As Object, Maildb As Object, workspace As Object, UIdoc As Object, UserName As String
Dim MailDbName As String

ThisWorkbook.Activate
For Each Wb In Workbooks
     If Not (Wb Is ActiveWorkbook) Then Wb.Close savechanges:=False
Next


End Sub

Sub AD_Audit（）
'列中的最后一个单元格
将ws设置为工作表
将最后一个单元格设置为范围
Dim LastCellRowNumber尽可能长
将wb3设置为工作簿
设置ws=工作表（2）
与ws
设置LastCell=.Cells（.Rows.Count，“A”）.End（xlUp）
LastCellRowNumber=LastCell.Row+1
以
将Wb设置为工作簿，将wb2设置为工作簿
作为变量的Dim vFile
'设置源工作簿
设置Wb=ActiveWorkbook
'打开目标工作簿
vFile=Application.GetOpenFilename（“Excel文件，*.xlsx”_
1，“选择一个要打开的文件”，False）
'如果用户没有选择文件，请退出sub
如果TypeName（vFile）=“Boolean”，则退出Sub
工作簿。打开vFile
'设置所选工作簿
设置wb2=ActiveWorkbook
'选择要复制的单元格
wb2.Worksheets（2）.Range（“A1:BD”和ActiveSheet.Cells.SpecialCells（xlCellTypeLastCell.Row）。选择
选择，复制
'返回要粘贴到的原始工作簿
Wb.激活
'从最后一个空行开始粘贴
Wb.工作表（2）.激活
Wb.工作表（2）.范围（“A1”）。选择
Selection.Paste特殊粘贴：=xlPasteValues，操作：=xlNone，SkipBlank_
：=假，转置：=假
Application.CutCopyMode=False
Application.ScreenUpdating=True
作为字符串的Dim LstrDate
日期
LstrDate=“2003年4月6日”
LDate=CDate（Lsrdate）
'搜索包含所需数据的列
作为整数的Dim x
最后一排一样长
lastRow=单元格。查找（内容：=“*”，搜索顺序：=xlByRows，搜索方向：=xlPrevious）。行
变光范围
带量程（“A:DB”）
设置rFind=.Find（内容：=“上次更新的帐户”，LookAt:=xlWhole，MatchCase:=False，SearchFormat:=False）
如果不是，那么rFind什么都不是
如果结束
以
Dim rFind1 As范围
带量程（“A:DB”）
设置rFind1=.Find（What:=“终止日期”，LookAt:=xlother，MatchCase:=False，SearchFormat:=False）
如果不是rFind1什么都不是，那么
如果结束
以
Dim rFind2 As范围
带量程（“A:DB”）
Set rFind2=.Find（What:=“上次密码设置日期”，LookAt:=xlother，MatchCase:=False，SearchFormat:=False）
如果不是rFind2什么都不是，那么
如果结束
以
'创建列并用公式填充
x=ActiveSheet.UsedRange.Columns.Count
ActiveSheet.Cells（1，x+1）=“终止后上次更新的帐户”
intcounter=2
而（intcounter日期值作为数值存储在工作表单元格中，因此不同的格式可以应用于不同的单元格，并且仍然保持比较（或加、减等）的能力。应用于每个单元格的公式在实际值为0时强制以特定文本格式进行比较

关键是要将公式设置为使用单元格的地址，而不是单元格内容

因此，您的单元格公式可以简单地为：

ActiveSheet.Cells（intcounter，x+1）.Formula=“=If（“&Cells（intcounter，rFind.Column）。Address&“>=”&Cells（intcounter，rFind1.Column）。Address&“，”review“，”disabled“）”