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

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

2 个答案: