Excel通过具有连接string的macrosparsing多行数据列

我有一个超过20000行数据运行的excel列。 数据格式几乎是一致的，需要通过macrosparsing新插入的列。 很less有parsing是直接的，很less需要堆叠和连接的string。

单个单元格中的重复多行数据的示例

LEGAL DETAILS FOR US5515106 Actual or expected expiration date=2014-05-26 Legal state=DEAD Status=EXPIRED Event publication date=1994-05-26 Event code=US/APP Event indicator=Pos Event type=Examination events Application details Application country=US US08249915 Application date=1994-05-26 Standardized application number=1994US-08249915 Event publication date=1994-07-21 Event code=US/AS Event type=Change of name or address Event type=Reassignment Assignment OWNER: THOMSON CONSUMER ELECTRONICS, INC., INDIANA Effective date of the event=1994-06-08 ASSIGNMENT OF ASSIGNORS INTEREST ASSIGNORS:CHANEY, JOHN WILLIAM BRIDGEWATER, KEVIN ELLIOTT REEL/FRAME:007121/0966 Event publication date=1996-05-07 Event code=US/A Event indicator=Pos Event type=Event indicating In Force Patents Granted before 2001-04-15 Publication country=US Publication number=US5515106 Publication stage Code=A Publication date=1996-05-07 Standardized publication number=US5515106 Event publication date=1999-05-18 Event code=US/NMFP Event type=Payment or non-payment notifications Publication of First Notice of Maintenance Fees Payable. PAYMENT NOTICE YEAR: Year of payment of annual fees=3 Event publication date=1999-09-27 Event code=US/FPAY Event indicator=Pos Event type=Event indicating In Force Event type=Payment or non-payment notifications Fee payment Annual fees payment date=1999-09-27 Year of payment of annual fees=4 Event publication date=1999-10-26 Event code=US/NMFP Event type=Payment or non-payment notifications Publication of First Notice of Maintenance Fees Payable. PAYMENT NOTICE YEAR: Year of payment of annual fees=3 Event publication date=2003-05-13 Event code=US/NMFP Event type=Payment or non-payment notifications Publication of First Notice of Maintenance Fees Payable. PAYMENT NOTICE YEAR: Year of payment of annual fees=7 Event publication date=2003-10-03 Event code=US/FPAY Event indicator=Pos Event type=Event indicating In Force Event type=Payment or non-payment notifications Fee payment Annual fees payment date=2003-10-03 Year of payment of annual fees=8 Event publication date=2007-05-22 Event code=US/NMFP Event type=Payment or non-payment notifications Publication of First Notice of Maintenance Fees Payable. PAYMENT NOTICE YEAR: Year of payment of annual fees=11 Event publication date=2007-10-18 Event code=US/FPAY Event indicator=Pos Event type=Event indicating In Force Event type=Payment or non-payment notifications Fee payment Annual fees payment date=2007-10-18 Year of payment of annual fees=12 Event publication date=2014-05-26 Event code=US/EEDX Event indicator=Neg Event type=Event indicating Not In Force Patent has expired 

如果我们仔细观察，首先有四条线是不同的，数据后跟“=”分别被parsing。 在这个重复的顺序之后：

活动发布date

事件代码

事件指示器

事件types

我有兴趣做以下单个单元格中的数据：

1.我已经插入了具有相同的多行开始的某个列，即在这种情况下，“=”符号的前面写入的date被parsing。 进一步，因为每个多行有许多这样的重复date，我们需要堆叠和单个相应的行，所有date按时间顺序分组。

2.在“事件types”列的一个特殊情况下，我需要将两个相应的字段“事件发布date”和事件types连接在一起，并将它们堆叠在单个单元格中

3.在第二种特殊情况下，我只需要获取事件发布date和事件types连接在一起的最后一个多行部分。

进一步解释这个样本Excel数据可以从LINK和期望的结果格式下载手动完成可以从LINK下载格式

到现在为止，我已经制定了以下代码： –

 Sub LegalStatus() On Error GoTo eh If HeaderExists("Table1", "Event publication date") = True Then MsgBox "You have Already Done Legal Split!" Exit Sub Else Dim x As Variant Dim y As Variant Dim a() As Variant Dim r As Long Dim i As Long Dim j As Long Dim colNum As Integer colNum = ActiveSheet.Rows(1).Find(what:="Legal Status", lookat:=xlWhole).Column ActiveSheet.Columns(colNum + 1).Insert ActiveSheet.Columns(colNum + 1).Insert ActiveSheet.Columns(colNum + 1).Insert ActiveSheet.Columns(colNum + 1).Insert ActiveSheet.Columns(colNum + 1).Insert ActiveSheet.Columns(colNum + 1).Insert ActiveSheet.Columns(colNum + 1).Insert ActiveSheet.Columns(colNum + 1).Insert ActiveSheet.Cells(1, colNum + 1).Value = "Actual or expected expiration date" ActiveSheet.Cells(1, colNum + 2).Value = "Legal state" ActiveSheet.Cells(1, colNum + 3).Value = "Status" ActiveSheet.Cells(1, colNum + 4).Value = "Event publication date" ActiveSheet.Cells(1, colNum + 5).Value = "Event type" ActiveSheet.Cells(1, colNum + 6).Value = "Latest Event Type" ActiveSheet.Cells(1, colNum + 7).Value = "Year of payment of annual fees" ActiveSheet.Cells(1, colNum + 8).Value = "Annual fees payment date" For r = 2 To Cells(Rows.Count, 1).End(xlUp).Row y = "Event publication date=" & SplitByLastOccurrence(Range("B" & r).Value, "Event publication 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 If eh: MsgBox "Sorry No Legal Status Column: " & Err.Description 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 

我相信只有专家才能帮助我。