Datumsformat Problem bei Excel

Question

Hallo Ich habe ein Problem mit einem Makro, das Informationen aus einer Arbeitsmappe kopiert und in eine andere Arbeitsmappe einfügt. Dann erstellt es zwei Spalten und füllt sie mit einer IF-Formel, um zwei Daten zu vergleichen. Diese Formeln bringen das falsche Ergebnis, da eine der Spalten ein anderes Datumsformat hat, und ich kann es nicht ändern, was auch immer ich an der Zelle mache, funktioniert nicht, nur wenn ich den Wert für irgendeine Zelle dieser Spalte lösche und ein Datum schreibe Ich kann das Format ändern.

Das benötigte Hauptformat ist YYYY-MM-DD, aber diese Spalte wird als TT/MM/JJJJ festgelegt, auch wenn ich die Zelle aktualisiere und sie als Datum oder Benutzerdefiniert festlege, funktioniert sie überhaupt nicht zeigt das falsche Format an.

Dies ist das Makro, an dem ich arbeite, gibt es eine Möglichkeit, dieses Problem zu lösen?

Vielen Dank im Voraus.

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 

Answer 1

Datumswerte werden in einer Arbeitsblatt-Zelle als numerischer Wert so unterschiedlichen Formaten zu unterschiedlichen Zellen angewendet werden kann gespeichert und behalten immer noch die Fähigkeit (oder zu addieren, subtrahieren, etc) zu vergleichen. Die Formel, die Sie auf jede Zelle anwenden, erzwingt einen Vergleich in einem bestimmten Textformat, wenn der tatsächliche Wert angezeigt wird.

Der Schlüssel ist, Ihre Formel zu setzen, um die Adresse der Zelle zu verwenden, nicht den Zelleninhalt.

So können Sie Ihre Zelle Formel einfach sein:

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