Question

我有一个多列Excel，其中包含带有标题'NCT'的特定列，它包含一个具有以下模式的多行重复文本

学生注册日期= 2004-03-21

学生代码= NP / CPP

学生指标=否

学生类型=被拘留

学生详情

学生状态= MH MH4000001

学生日期= 2005-01-27

学生注册= 21045-sd-554729

学生注册日期= 2004-05-01

学生代码= NP / CPP

学生指标= Pos

学生类型=被拘留

学生详情

学生状态= MH MH4000001

学生日期= 2005-01-27

学生注册= 21045-sd-554729

学生注册日期= 2005-01-27

学生代码= NP / CPP

学生指标= Pos

学生类型=被拘留

学生详情

学生状态= MH MH4000001

学生日期= 2005-01-27

学生注册= 21045-sd-554729

我希望从NCT标题的每个ROW中提取最新的注册部分，当提取“学生注册日期”时，选中最近的一个并且整个后续文本直到“学生注册”被复制到新插入列的相应行。

结果我正在寻找下面的图像

任何人都可以通过一些帮助吗？

到目前为止工作的代码是

Sub Test()
    Dim x       As Variant
    Dim a()     As Variant
    Dim r       As Long
    Dim i       As Long
    Dim j       As Long

    For r = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        x = Split(Range("A" & r).Value, vbLf)
        For i = LBound(x) To UBound(x)
            If InStr(x(i), "=") Then
                ReDim Preserve a(j)
                a(UBound(a)) = Split(x(i), "=")(1)
                j = j + 1
            End If
        Next i
        Range("C" & r).Resize(, UBound(a) + 1).Value = a
        Erase x: Erase a: j = 0
    Next r
End Sub

Answer 1

试试此代码

＆＃13;

Sub Test()
    Dim x       As Variant
    Dim y       As Variant
    Dim a()     As Variant
    Dim r       As Long
    Dim i       As Long
    Dim j       As Long
    
    For r = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        y = "Student enrollment date=" & SplitByLastOccurrence(Range("A" & r).Value, "Student enrollment date")(1)
        x = Split(y, vbLf)
        For i = LBound(x) To UBound(x)
            If InStr(x(i), "=") Then
                ReDim Preserve a(j)
                a(UBound(a)) = Split(x(i), "=")(1)
                j = j + 1
            End If
        Next i
        Range("C" & r).Resize(, UBound(a) + 1).Value = a
        Erase x: Erase a: j = 0
    Next r
End Sub

Function SplitByLastOccurrence(s As String, delimiter As String)
    Dim arr, i As Long
    
    If Len(s) = 0 Or Len(delimiter) = 0 Then
        SplitByLastOccurrence = CVErr(2001)
    Else
        i = InStrRev(s, delimiter)
        If i = 0 Then
            SplitByLastOccurrence = Array(s)
        Else
            ReDim arr(0 To 1)
            arr(0) = Trim(Left$(s, i - 1))
            arr(1) = Trim(Mid$(s, i + Len(delimiter) + 1))
            SplitByLastOccurrence = arr
        End If
    End If
End Function

＆＃13;

Answer 2

你可能会追随以下内容：

Option Explicit

Sub main()
    Dim cell As Range
    Dim recentStudent As String
    Dim studentInfo As Variant

    For Each cell In Range("A2", Cells(Rows.count, 1).End(xlUp))
        recentStudent = Replace(GetMostRecentStudent(cell.Text), "Student details" & vbLf, "")
        cell.Offset(, 1) = recentStudent
        For Each studentInfo In Split(recentStudent, vbLf)
            cell.End(xlToRight).Offset(, 1).Value = Split(studentInfo, "=")(1)
        Next
    Next
End Sub

Function GetMostRecentStudent2(cellTxt As String)
    GetMostRecentStudent = Right(cellTxt, Len(cellTxt) - InStrRev(cellTxt, "Student enrollment date") + 1)
End Function

从Excel单元格宏中提取多行文本

2 个答案: