Excel VBA代码不粘贴为date值

我有以下代码创build新的列“M”和粘贴date值从列“L”后面逗号分隔符。 问题并不是所有的价值都被粘贴为数字date，尽pipe它们看起来像这样。 导致我问题进一步下降，我创build一个数据透视表，并需要按datesorting列标题。 还有一些date只有date而不是yyyy

With Sheets("DataSheet") newLastRow = pasteRowIndex If IsArray(v) Then .Columns(13).Insert Shift:=xlToRight For i = 1 To newLastRow If InStr(1, .Cells(i, "L"), ",") Then .Cells(i, "M").Value = Split(.Cells(i, "L"), ",")(1) 

不知道这下一行是否正确

  Cells(i, "M").NumberFormat = "dd/mm/yyyy" End If Next i End If 

  Dim PSheet As Worksheet Dim DSheet As Worksheet Dim PCache As PivotCache Dim PTable As PivotTable Dim PRange As Range Dim LastRow1 As Long Dim LastCol As Long 'Insert a New Blank Worksheet On Error Resume Next Application.DisplayAlerts = False Worksheets("PivotTable").Delete Sheets.Add Before:=ActiveSheet ActiveSheet.Name = "PivotTable" Application.DisplayAlerts = True 'Switch off error masking On Error GoTo 0 Set PSheet = Worksheets("PivotTable") Set DSheet = Worksheets("DataSheet") 'With DSheet 'Define Data Range LastRow1 = DSheet.Cells(Rows.Count, "B").End(xlUp).Row LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column Set PRange = DSheet.Cells(1, "B").Resize(LastRow, 20) 'Define Pivot Cache Set PCache = ActiveWorkbook.PivotCaches.Create _ (SourceType:=xlDatabase, SourceData:=PRange) 'Insert Blank Pivot Table Set PTable = PCache.CreatePivotTable _ (TableDestination:=PSheet.Cells(1, 1), TableName:="MilestonePivotTable") 'Insert Row Fields With PTable.PivotFields("Contract Identifier") .Orientation = xlRowField .Position = 1 End With With PTable.PivotFields("SOW ID") .Orientation = xlRowField .Position = 2 End With With PTable.PivotFields("Resource Name") .Orientation = xlRowField .Position = 3 End With With PTable.PivotFields("Deliverable") .Orientation = xlRowField .Position = 4 End With 'Insert Column Fields With PTable.PivotFields("Milestone Date") .Orientation = xlColumnField .Position = 1 End With ActiveSheet.PivotTables("MilestonePivotTable").PivotFields("Milestone Date").AutoSort xlAscending, "Milestone Date" 'Insert Data Field With PTable.PivotFields("Milestone Date") .Orientation = xlDataField .NumberFormat = "0" End With End Sub 

Answer 1

我已经试过了，它似乎是做你所期待的，它会一次循环单元格中的一个字符，如果它包含除了/或数字之外的任何东西，它将删除它们，然后它将格式化单元格作为date：

 Sub foo() Dim StartString As String Dim DateValue As String Dim y As Integer Dim LastRow As Long With Sheets("DataSheet") LastRow = .Cells(.Rows.Count, "L").End(xlUp).Row 'find the last row on column L .Columns(13).Insert Shift:=xlToRight 'add a new column to the right of column L For i = 1 To LastRow 'loop through rows If InStr(1, .Cells(i, "L"), ",") Then .Cells(i, "M").Value = Split(.Cells(i, "L"), ",")(1) 'split after comma StartString = .Cells(i, "L").Value DateValue = "" For y = 1 To Len(StartString) 'loop to remove unwanted characters Select Case Asc(Mid(StartString, y, 1)) Case 47 To 57 DateValue = DateValue & Mid(StartString, y, 1) End Select Next y .Cells(i, "M").Value = DateValue 'return the date .Cells(i, "M").NumberFormat = "dd/mm/yyyy" 'format it correctly End If Next i End With End Sub 

如果你的代码确实插入了列，并用逗号后面的所有数据填充单元格，那么你可以简单地将以下代码包含到你的代码中，它也应该适用于你：

 StartString = .Cells(i, "L").Value DateValue = "" For y = 1 To Len(StartString) 'loop to remove unwanted characters Select Case Asc(Mid(StartString, y, 1)) Case 47 To 57 DateValue = DateValue & Mid(StartString, y, 1) End Select Next y .Cells(i, "M").Value = DateValue 'return the date .Cells(i, "M").NumberFormat = "dd/mm/yyyy" 'format it correctly