时间戳

首页 > 解决方案 > 如果日期校正VBA的条件

excel - 如果日期校正VBA的条件

问题描述

我发现了有关日期格式的问题，并且我建立了一个 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))"

所以当它到达 Range("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

标签： excelvba

解决方案

无需遍历工作表上的每个单元格。只需遍历您的目标列 ( 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

推荐阅读