Excel VBA代码不粘贴为日期值

Question

我有以下代码创建新列“M”并在逗号分隔符之后将列“L”中的日期值粘贴到它。问题不是所有值都粘贴为数字日期，尽管它们显示为数字日期。导致我在创建数据透视表并需要按日期对列标题进行排序的地方进一步出现问题。还有一些日期只有日期为 yy 而不是 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

我已经尝试过了，它似乎符合您的预期，它会一次循环遍历单元格一个字符，如果它包含除 / 或数字之外的任何内容，它将删除它们，然后它将格式化单元格作为日期：

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