提取字符串，根据字段生成excel表格

Sub read_from_excel()
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim path As String
'定位源文件路径
path = Range("B2").Value
Set xlBook = Workbooks.Open(path)
Set srcSheet = xlBook.Sheets("Campaign Conditions Logic")

'Define check field
Dim ArrayTitles() As Variant
ReDim Preserve ArrayTitles(39)
ArrayTitles(0) = "line1.order_submit_date"
ArrayTitles(1) = "line2.order_submit_date"
ArrayTitles(2) = "line3.order_submit_date"
ArrayTitles(3) = "device1.order_submit_date"
ArrayTitles(4) = "device2.order_submit_date"
ArrayTitles(5) = "device3.order_submit_date"
ArrayTitles(6) = "line1.billing_start_date"
ArrayTitles(7) = "line2.billing_start_date"
ArrayTitles(8) = "line3.billing_start_date"
ArrayTitles(9) = "device1.actual_delivery_date"
ArrayTitles(10) = "device2.actual_delivery_date"
ArrayTitles(11) = "device3.actual_delivery_date"
ArrayTitles(12) = "line1.call_deadline_hint"
ArrayTitles(13) = "line2.call_deadline_hint"
ArrayTitles(14) = "line3.call_deadline_hint"
ArrayTitles(15) = "line1.call_used"
ArrayTitles(16) = "line2.call_used"
ArrayTitles(17) = "line3.call_used"
ArrayTitles(18) = "line1.shop_id"
ArrayTitles(19) = "line2.shop_id"
ArrayTitles(20) = "line3.shop_id"
ArrayTitles(21) = "line1.channel"
ArrayTitles(22) = "line2.channel"
ArrayTitles(23) = "line3.channel"
ArrayTitles(24) = "device1.shop_id"
ArrayTitles(25) = "device2.shop_id"
ArrayTitles(26) = "device3.shop_id"
ArrayTitles(27) = "device1.channel"
ArrayTitles(28) = "device2.channel"
ArrayTitles(29) = "device3.channel"
ArrayTitles(30) = "device1.device_id"
ArrayTitles(31) = "device2.device_id"
ArrayTitles(32) = "device3.device_id"
ArrayTitles(33) = "line1.payment_status"
ArrayTitles(34) = "line2.payment_status"
ArrayTitles(35) = "line3.payment_status"
ArrayTitles(36) = "device1.payment_status"
ArrayTitles(37) = "device2.payment_status"
ArrayTitles(38) = "device3.payment_status"
ArrayTitles(39) = "campaign.applied_campaign_code"
ArrayTitles(40) = "priority1.exclude_campaign_code"
ArrayTitles(41) = "priority2.exclude_campaign_code"
ArrayTitles(42) = "priority3.exclude_campaign_code"
ArrayTitles(43) = "priority1.priority_campaign_code"
ArrayTitles(44) = "priority2.priority_campaign_code"
ArrayTitles(45) = "priority3.priority_campaign_code"
ArrayTitles(46) = "priority1.end_date"
ArrayTitles(47) = "priority2.end_date"
ArrayTitles(48) = "priority3.end_date"


Dim ArrayLen() As Variant
ReDim Preserve ArrayLen(39)
ArrayLen(0) = 10
ArrayLen(1) = 10
ArrayLen(2) = 10
ArrayLen(3) = 10
ArrayLen(4) = 10
ArrayLen(5) = 10
ArrayLen(6) = 10
ArrayLen(7) = 10
ArrayLen(8) = 10
ArrayLen(9) = 10
ArrayLen(10) = 10
ArrayLen(11) = 10
ArrayLen(12) = 10
ArrayLen(13) = 10
ArrayLen(14) = 10
ArrayLen(15) = 6
ArrayLen(16) = 6
ArrayLen(17) = 6
ArrayLen(18) = 7
ArrayLen(19) = 4
ArrayLen(20) = 4
ArrayLen(21) = 4
ArrayLen(22) = 4
ArrayLen(23) = 4
ArrayLen(24) = 4
ArrayLen(25) = 4
ArrayLen(26) = 4
ArrayLen(27) = 4
ArrayLen(28) = 4
ArrayLen(29) = 4
ArrayLen(30) = 10
ArrayLen(31) = 10
ArrayLen(32) = 10
ArrayLen(33) = 3
ArrayLen(34) = 3
ArrayLen(35) = 3
ArrayLen(36) = 3
ArrayLen(37) = 3
ArrayLen(38) = 3
ArrayLen(39) = 4
ArrayLen(40) = 4
ArrayLen(41) = 4
ArrayLen(42) = 4
ArrayLen(43) = 4
ArrayLen(44) = 4
ArrayLen(45) = 4
ArrayLen(46) = 10
ArrayLen(47) = 10
ArrayLen(48) = 10

Dim destSheet As Worksheet
Set destSheet = ThisWorkbook.Sheets("TestCase-Request")

Dim strName As String
Dim OpenBracket As Integer
Dim i, j, k As Integer
i = 2
For Each rngCell In Range("C4", Range("C4").End(xlDown))
       strName = rngCell.Value
       destSheet.Range("A" & i).Value = Mid(strName, 1, 5)
       i = i + 1
Next rngCell
destSheet.Range("A1").Value = "Case No"

For k = 1 To 39
j = 2
For Each rngCell In Range("N4", Range("N4").End(xlDown))
       strName = Application.Trim(rngCell.Value)
       OpenBracket = InStr(1, strName, ArrayTitles(k - 1))
       'MsgBox (OpenBracket)
       If OpenBracket = 0 Then
       destSheet.Cells(j, k + 1).Value = " "
       Else
       OpenBracket1 = OpenBracket + Len(ArrayTitles(k - 1)) + 1
       destSheet.Cells(j, k + 1).Value = Mid(strName, OpenBracket1 + 1, ArrayLen(k - 1))
       End If
       j = j + 1
Next rngCell
destSheet.Cells(1, k + 1).Value = ArrayTitles(k - 1)
Next k

xlBook.Close

End Sub

运行结果为：