Excel VBA跟随脚本未正确转换所有日期

Question

我有另外一个问题的脚本帮助我将值拆分为新列并将文本转换为日期

Dim StartString As String
Dim DateValue As String
Dim y As Integer

Dim LastRow2 As Long
With Sheets("DataSheet")
LastRow2 = .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 LastRow2 '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

我遇到的问题是转换在所有情况下都不成功。这会导致我的代码的下一个阶段出现问题，因为它使用新日期作为必须按时间顺序排序的列标题。任何帮助表示赞赏！

下面也是结果（请忽略黄色的单元格，因为此输入错误）绿色的单元格似乎已成功转换，但您可以看到许多其他单元格的左上角有一个小的绿色错误指示器。 ：

Answer 1

我建议下面的代码可能更容易处理和理解，最重要的是，对数据进行测试，类似于您在示例中提供的数据:)

Option Explicit

Sub ExtractDate()

    Dim DateValue As String, FinalDate As String
    Dim I As Integer

    Dim LastRow2 As Long
    With Sheets("DataSheet")

        LastRow2 = .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 LastRow2 'loop through rows

           If InStr(1, .Cells(I, "L"), ",") Then

                DateValue = Split(.Cells(I, "L"), ",")(1) 'split after comma

                If IsNumeric(Left(DateValue,2)) Then 

                    DateValue = Split(DateValue, "/")(1) & "/" & Split(DateValue, "/")(0) & "/" & Split(DateValue, "/")(2)
                    FinalDate = CDate(DateValue)

                    .Cells(I, "M").Value = Format(FinalDate, "dd/mm/yyyy")
                 End If
            End If

        Next I

    End With

End Sub

Answer 2

我相信我找到了罪魁祸首，尝试用以下内容替换您的代码：

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
    .Columns(13).Insert Shift:=xlToRight
    For i = 1 To LastRow
        If InStr(1, .Cells(i, "L"), ",") Then
            .Cells(i, "M").Value = Split(.Cells(i, "L"), ",")(1)
            StartString = .Cells(i, "L").Value
            DateValue = ""
            For y = 1 To Len(StartString)
                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
        End If
        If .Cells(i, "M").Value <> "" Then
            .Cells(i, "M").Value = CDate(.Cells(i, "M").Value)
            .Cells(i, "M").Value = Format(.Cells(i, "M").Value, "dd/mm/yyyy")
        End If
    Next i
End With
End Sub