date格式问题在Excel中

您好,我有一个macros从一个工作簿复制信息,并将其粘贴到另一个问题。 然后它创build两列,并填写一个IF公式来比较两个date。 这些公式带来了错误的结果,因为其中一个列有另一个date格式,我不能改变它,不pipe我在单元格上做什么不工作,只有当我擦除该列的任何单元格上的值,并写一个date我可以改变格式。

所需的主要格式是YYYY-MM-DD,但是这个列被设置为dd / mm / yyyy,即使我更新单元格并将其设置为date或自定义它根本不工作,它仍然显示错误的格式。

这是我工作的macros,有没有办法解决这个问题?

先谢谢你。

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 

date值作为数字值存储在工作表单元格中,因此可以将不同的格式应用于不同的单元格,并仍保留比较(或添加,减去等)的能力。 您应用于每个单元格的公式会强制以实际值进行特定文本格式的比较。

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

所以你的单元格公式可以简单地为:

ActiveSheet.Cells(intcounter, x + 1).Formula = "=If(" & Cells(intcounter, rFind.Column).Address & ">=" & Cells(intcounter, rFind1.Column).Address & ","""review""","""disabled""")"