Если условие для корректировки даты VBA

Question

Я нашел проблему с форматированием даты и построил условие If, чтобы я мог изменить те, которые этого не делают.

With ActiveSheet
        Dim arr As Variant: arr = .UsedRange.Value
        Dim i As Long
        For i = 2 To UBound(arr) 
            arr(i, 4) = arr(i, 4) 
           If IsNumeric(arr(i, 5)) = True Then
           'MsgBox "The value in A1 is numeric"
           Else
           arr(i, 5) = "=DATEVALUE(MID(RC[-7],1,10))"
           'MsgBox "The value in A1 is not numeric"
        End If

        Next i

        .UsedRange.Value = arr
        .Range("D:D").NumberFormat = "dd/mm/yyyy"   'change to any date-based number format you prefer the cells to display
        .Range("E:E").NumberFormat = "m/d/yyyy"   'change to any date-based number format you prefer the cells to display
    End With

Я записал этот макрос, чтобы я мог видеть, как изменить значение на номер:

arr(i, 5) = "=DATEVALUE(MID(RC[-7],1,10))"

Поэтому, когда он достигнет диапазона («E: E»), он изменится на нужный мне формат.

Если вы можете помочь мне адаптировать записанный макрос в мое If-Then-Else это будет оценено.

ActiveCell.FormulaR1C1 = "=DATEVALUE(MID(RC[-7],1,10))"

Столбец, который я хочу изменить, - это E

Весь код:

Option Explicit
Sub para_Importar_()

    Dim mPath As Variant 'nunca dejes implicitos los variant
    mPath = Application.GetOpenFilename("Archivos de texto (*.txt),*.txt)")
    If VarType(mPath) = vbBoolean Then Exit Sub
    Application.ScreenUpdating = False
    mPath = Left(mPath, InStrRev(mPath, "\"))

    Dim iFile As String 'ya no se utilizan los símbolos para los tipos de variables
    iFile = Dir(mPath & "*.txt")

    Dim ws As Worksheet
    Set ws = Workbooks.Add(xlWBATWorksheet).Sheets(1)
Do Until iFile = ""
  ws.Parent.Worksheets.Add after:=ws.Parent.Worksheets(ws.Parent.Worksheets.Count)
  ActiveSheet.Name = iFile

  With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & _
    mPath & iFile, Destination:=ActiveSheet.Range("$A$1"))
    .AdjustColumnWidth = True: .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = True: .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = False: .TextFileSpaceDelimiter = False
    .TextFileDecimalSeparator = ".": .TextFileThousandsSeparator = ","
    .Refresh BackgroundQuery:=False
  End With

  Dim objRange1 As Range

    'Set up the ranges
  Set objRange1 = Range("A1:A1048576")

    'Do the first parse
    objRange1.TextToColumns _
     Destination:=Range("A1"), _
      DataType:=xlDelimited, _
      Tab:=False, _
      Semicolon:=False, _
      Comma:=False, _
      Space:=False, _
      other:=True, _
      OtherChar:="|"

  With Range("A1").CurrentRegion
.Value = Evaluate("IF(ROW( " & .Address & "),CLEAN(TRIM(" & .Address & ")))")
End With

With ActiveSheet
        Dim arr As Variant: arr = .UsedRange.Value
        Dim i As Long
        For i = 2 To UBound(arr) 'empezamos por la fila 2 ya que supongo que la fila 1 tiene encabezados
            arr(i, 4) = arr(i, 4) * 1 'con esto multiplicas el valor de la celda por 1 y se convierte en valor. Dará fallo si alguna celda es texto de verdad.
          'If IsNumeric(arr(i, 5)) Then
           'MsgBox "The value in A1 is numeric"
           'Else
           'MsgBox "The value in A1 is not numeric"
           'Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") '<--- Update
    End If

       Next i

        .UsedRange.Value = arr
        .Range("D:D").NumberFormat = "dd/mm/yyyy"   'change to any date-based number format you prefer the cells to display
        .Range("E:E").NumberFormat = "dd/mm/yyyy"   'change to any date-based number format you prefer the cells to display
    End With

  With ActiveSheet.Range("a1", ActiveSheet.[a3].CurrentRegion)
    .Cells(2, 1).Select: ActiveWindow.FreezePanes = True
    .RowHeight = 14: .Font.Size = 8: .Columns.AutoFit
  End With
  iFile = Dir
Loop

Application.DisplayAlerts = False
  ActiveWorkbook.Sheets(1).Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Answer 1

Не нужно l oop через каждую ячейку на вашем листе. Просто l oop через целевой столбец (Column E) и выполните отрицательный тест (Not IsNumeric)

---

Sub Date_Fixer()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") '<--- Update
Dim lr As Long, iCell as Range, i as Range

lr = ws.Range("E" & ws.Rows.Count).Row
Set iCell = ws.Range("E2:E" & lr)                 '<--- Assumes data starts on second row

For Each i In iCell
    If Not IsNumeric(i) Then
        i = Mid(i, 1, 10)
    End If
Next i

ws.Range("E:E").NumberFormat = "dd/mm/yyyy"

End Sub