在VBA中将date值列从YYYYMMDD更改为MM / DD / YYYY
我有一个表格的date值范围，显示date值为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 / YYYYdate格式的date值。
如何在复制到outputWS之前执行此操作？
自定义函数怎么样？
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")
我把它弄出来了！ 决定将新值移动到一个新的“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"