循环一个宏,将A列中的日期格式更改为C列,然后继续,直到它到达A列中最后一个使用过的单元格

时间:2017-04-12 13:48:22

标签: excel-vba loops date vba excel

循环一个宏,将A列中的日期格式更改为C列,然后继续,直到它到达A列中最后一个使用过的单元格。

我只能让它改变A1中的日期 - 我需要它循环直到A列为空白:

Sub Macro1()
  '
  ' Macro1 Macro
  Dim ShipDate, Temp, DateForImport
  Set ShipDate = Range("A1") ' or whatever cell the date is entered into (D30)

  For I = 1 To 1
    On Error Resume Next
    Set Temp = Range("A1")

    If Len(Temp.Text) > 1 Then
      Set TempDate = Temp
      'FORMAT SHIP DATE From MM/DD/YY OR MM/DD/YYYY TO YYYY-MM-DD
      'if single digit month or day then fix it
      If Len(TempDate.Text) = 10 Then
        TempDate = TempDate
        Exit For
      End If
      'case M/DD/YYYY length 9
      If Len(TempDate.Text) = 9 And Mid(TempDate, 2, 1) = "/" Then
        TempDate = "0" + Right(TempDate, 9)
        Exit For
      End If
      'case MM/D/YYYY length 9
      If Len(TempDate.Text) = 9 And Mid(TempDate, 3, 1) = "/" Then
        TempDate = Left(TempDate, 3) + "0" + Right(TempDate, 6)
        Exit For
      End If
      'case MM/DD/YY length 8
      If Len(TempDate.Text) = 8 And Mid(TempDate, 3, 1) = "/" Then
        TempDate = Left(TempDate, 6) + "20" + Right(TempDate, 2)
        Exit For
      End If
      'case M/D/YYYY length 8
      If Len(TempDate.Text) = 8 And Mid(TempDate, 2, 1) = "/" Then
        TempDate = "0" + Left(TempDate, 2) + "0" + Right(TempDate, 6)
        Exit For
      End If
      'case M/DD/YY length 7
      If Len(TempDate.Text) = 7 And Mid(TempDate, 2, 1) = "/" Then
        TempDate = "0" + Left(TempDate, 2) + Mid(TempDate, 3, 3) + "20" + Right(TempDate, 2)
        Exit For
      End If
      'case MM/D/YY length 7
      If Len(TempDate.Text) = 7 And Mid(TempDate, 3, 1) = "/" Then
        TempDate = Left(TempDate, 3) + "0" + Mid(TempDate, 4, 2) + "20" + Right(TempDate, 2)
        Exit For
      End If
      'case M/D/YY length 6
      If Len(TempDate.Text) = 6 And Mid(TempDate, 2, 1) = "/" Then
        TempDate = "0" + Left(TempDate, 2) + "0" + Mid(TempDate, 3, 2) + "20" + Right(TempDate, 2)
        Exit For
      End If

      'MsgBox "found Ship Date:  " + ShipDate
      Exit For
    End If

  Next I

  DateForImport = "20" + Right(TempDate, 2) + Left(TempDate, 2) + Mid(TempDate, 4, 2)
  Range("C1") = DateForImport

End Sub

1 个答案:

答案 0 :(得分:0)

首先需要定义最后一行,然后设置临时范围。尝试将其替换为您的宏并运行它。

    lRow = WorksheetFunction.Max(Range("A65536").End(xlUp).Row)

    With ActiveSheet
    For i = lRow To 2 Step -1
    On Error Resume Next
    Set Temp = Range("A" & i)