在VBA中將日期值列從YYYYMMDD更改為MM / DD / YYYY

Question

我為一張紙設置了一系列日期值，這些日期值將日期值顯示為20160812。我正在尋找值，以顯示為08/12/2016。

這是我目前擁有的代碼：

Private Sub Update_Click()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim path As String, fileName As String
Dim lastRowUniversal As Long, lastRowOutput As Long, rowCntr As Long, lastColumn As Long
Dim inputWS1 As Worksheet, inputWS2 As Worksheet, inputWS3 As Worksheet, outputWS As Worksheet



Const dtFORM As String = "=IF(ISNUMBER(J4:J<r>),DATE(YEAR(J4:J<r>)-1," & "MONTH(J4:J<r>),DAY(J4:J<r>)),J4:J<r>)"



'set your sheets here
Set inputWS1 = ThisWorkbook.Sheets("Universal")
Set inputWS2 = ThisWorkbook.Sheets("Geovera")
Set inputWS3 = ThisWorkbook.Sheets("Citizens")
Set outputWS = ThisWorkbook.Sheets("Carriers")


    'get last rows from both sheets
lastRowUniversal = inputWS1.Cells(Rows.Count, "A").End(xlUp).Row
LastRowCitizens = inputWS3.Cells(Rows.Count, "A").End(xlUp).Row
lastRowGeovera = inputWS2.Cells(Rows.Count, "A").End(xlUp).Row
LastRowPolicy = outputWS.Cells(Rows.Count, "B").End(xlUp).Row
lastRowOutput = outputWS.Cells(Rows.Count, "A").End(xlUp).Row
lastColumn = inputWS1.Cells(1, Columns.Count).End(xlToLeft).Column


    'get last rows from both sheets
lastRowUniversal = inputWS1.Cells(Rows.Count, "A").End(xlUp).Row
LastRowCitizens = inputWS3.Cells(Rows.Count, "A").End(xlUp).Row
lastRowGeovera = inputWS2.Cells(Rows.Count, "A").End(xlUp).Row
LastRowPolicy = outputWS.Cells(Rows.Count, "B").End(xlUp).Row
lastRowOutput = outputWS.Cells(Rows.Count, "A").End(xlUp).Row
lastColumn = inputWS1.Cells(1, Columns.Count).End(xlToLeft).Column

rowCntr = 1

'get last rows from both sheets
lastRowUniversal = inputWS1.Cells(Rows.Count, "A").End(xlUp).Row
LastRowCitizens = inputWS3.Cells(Rows.Count, "A").End(xlUp).Row
lastRowGeovera = inputWS2.Cells(Rows.Count, "A").End(xlUp).Row
LastRowPolicy = outputWS.Cells(Rows.Count, "B").End(xlUp).Row
lastRowOutput = outputWS.Cells(Rows.Count, "A").End(xlUp).Row
lastColumn = inputWS1.Cells(1, Columns.Count).End(xlToLeft).Column

'Universal
inputWS1.Range("A4:A" & lastRowUniversal).Copy outputWS.Range("B2")
inputWS1.Range("B4:B" & lastRowUniversal).Copy outputWS.Range("C2")
inputWS1.Range("N4:N" & lastRowUniversal).Value = inputWS1.Name
inputWS1.Range("N4:N" & lastRowUniversal).Copy outputWS.Range("E2")
inputWS1.Range("L4:L" & lastRowUniversal).Value = inputWS1.Evaluate(Replace(dtFORM, "<r>", lastRowUniversal))
inputWS1.Range("L4:L" & lastRowUniversal).Copy outputWS.Range("G2")
inputWS1.Range("G4:G" & lastRowUniversal).Copy outputWS.Range("H2")

'Geovera

inputWS2.Range("F2:F" & lastRowGeovera).Copy outputWS.Range("B" & lastRowUniversal - 1)
inputWS2.Range("I2:I" & lastRowGeovera).Copy outputWS.Range("C" & lastRowUniversal - 1)
inputWS2.Range("P2:P" & lastRowGeovera).Value = inputWS2.Name
inputWS2.Range("P2:P" & lastRowGeovera).Copy outputWS.Range("E" & lastRowUniversal - 1)
inputWS2.Range("N2:N" & lastRowGeovera).Copy outputWS.Range("H" & lastRowUniversal - 1)
inputWS2.Range("G2:G" & lastRowGeovera).Copy outputWS.Range("G" & lastRowUniversal - 1)

'Citizens
inputWS3.Range("D2:D" & LastRowCitizens).Copy inputWS3.Range("N2:N" & LastRowCitizens)
inputWS3.Range("B2:B" & LastRowCitizens).Copy outputWS.Range("C" & lastRowGeovera + (lastRowUniversal - 2))
inputWS3.Range("M2:M" & LastRowCitizens).Value = inputWS3.Name
inputWS3.Range("M2:M" & LastRowCitizens).Copy outputWS.Range("E" & lastRowGeovera + (lastRowUniversal - 2))
inputWS3.Range("E2:E" & LastRowCitizens).Copy outputWS.Range("G" & lastRowGeovera + (lastRowUniversal - 2))
inputWS3.Range("J2:J" & LastRowCitizens).Copy outputWS.Range("H" & lastRowGeovera + (lastRowUniversal - 2))

inputWS3.Columns("N").NumberFormat = "@"

With inputWS3
For i = 2 To LastRowCitizens
    .Cells(i, "N") = Left(.Cells(i, "N").Value, 8)
Next i


End With

inputWS3.Range("N2:N" & LastRowCitizens).Copy outputWS.Range("B" & lastRowGeovera + (lastRowUniversal - 2))

'Formatting



Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

我要修復的行是：inputWS2.Range（“ G2：G”＆lastRowGeovera）.Copy outputWS.Range（“ G”＆lastRowUniversal-1）

范圍G2：G具有我需要更改為MM / DD / YYYY日期格式的日期值。

在復制到outputWS之前如何實現？

Answer 1

自定義功能如何？

Public Function ToDate(ByVal s As String) As Date
    ToDate = DateValue(Right(s, 2) & "/" & Mid(s, 5, 2) & "/" & Left(s, 4))
End Function

調用它：

Dim d As Date
    d = ToDate("20160812")

Answer 2

我想通了！ 決定將新值移動到新的列“ Q”，因為多次運行代碼將破壞數據：

With inputWS2
For i = 2 To LastRowGeovera
    Y = Left(.Cells(i, "G").Value, 4)
    M = Mid(.Cells(i, "G").Value, 5, 2)
    D = Right(.Cells(i, "G").Value, 2)
    .Cells(i, "Q") = M & "/" & D & "/" & Y

Next i
End With

inputWS2.Columns("Q").NumberFormat = "mm/dd/yyyy"