我有一个excel列，运行超过20000行数据。数据格式几乎是一致的，需要通过宏解析到新插入的列。很少解析是直接的，很少需要堆叠和连接字符串。
单个单元格中重复多行数据的示例
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
如果仔细观察，前四行不同，数据后跟＆＃39; =＆＃39;被单独解析。 遵循此重复顺序后： -
活动发布日期
活动代码
活动指标
活动类型
我有兴趣关注单细胞中存在的这些数据： -
1。我插入了具有相同多线起点的某列，即“事件发布日期”＃39;在这种情况下，日期写在＆＃39; =＆＃39;标志被解析。此外，由于每条多线都有许多这样的重复日期，我们需要堆叠和单个相应的行，所有日期按时间顺序分组。
2。在＆＃39;事件类型＆＃39;的特殊情况之一专栏我需要连接两个相应的字段＆＃39;事件发布日期＆＃39;和事件类型一起并将它们堆叠在单个单元格中
3. 在第二个特例中，我只需要获取其中事件发布日期和事件类型连接在一起的最后一个多行部分。
为了解释这一点，可以从LINK下载Sample Data Data样本，并且可以从LINK Desired Format下载手动完成的所需结果格式
到目前为止，我已经制定了以下代码： -
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
我相信只有专家可以帮助我。