试试这个 VBA 宏。它使用正则表达式来解析出不同的段;但如果数据不是你呈现的方式,它就会失败;因此,如果出现故障,您需要查看它与我的假设或您呈现数据的方式有何不匹配。
宏假设数据从 A1 开始,位于 A 列,第 1 行没有标签。结果写入 B 列及后续;带有标签第 1 行 - 但这些可以放置在任何地方。
此代码进入常规模块。
Option Explicit
Sub ParseBiblio()
Dim vData As Variant
Dim vBiblios() As Variant
Dim rRes As Range
Dim re As Object, mc As Object
Dim I As Long
'Assume Data is in column A.
'Might need to start at row 2 if there is a label row
vData = Range("A1", Cells(Rows.Count, "A").End(xlUp))
'Results to start in Column B with labels in row 1
Set rRes = Range("b1")
Set re = CreateObject("vbscript.regexp")
With re
.MultiLine = True
.Global = True
.ignorecase = True
.Pattern = "(^[^,]+),?\s*([^,]+?)(?:,\s*([^(]+))?\s*\((\d{4})\)\s*(.*?\.)\s*(?:In:\s*(.*)\.)?\s*(.*)"
End With
'Results array and labels
ReDim vBiblios(1 To UBound(vData) + 1, 1 To 7)
vBiblios(1, 1) = "First Author"
vBiblios(1, 2) = "Second Author"
vBiblios(1, 3) = "Other Authors"
vBiblios(1, 4) = "Publication Year"
vBiblios(1, 5) = "Title"
vBiblios(1, 6) = "Published In"
vBiblios(1, 7) = "More Info"
For I = 1 To UBound(vData)
Set mc = re.Execute(vData(I, 1))
If mc.Count > 0 Then
With mc(0)
vBiblios(I + 1, 1) = .submatches(0)
vBiblios(I + 1, 2) = .submatches(1)
vBiblios(I + 1, 3) = .submatches(2)
vBiblios(I + 1, 4) = .submatches(3)
vBiblios(I + 1, 5) = .submatches(4)
vBiblios(I + 1, 6) = .submatches(5)
vBiblios(I + 1, 7) = .submatches(6)
End With
End If
Next I
Set rRes = rRes.Resize(rowsize:=UBound(vBiblios, 1), columnsize:=UBound(vBiblios, 2))
rRes.EntireColumn.Clear
rRes = vBiblios
With rRes
With .Rows(1)
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
.EntireColumn.AutoFit
End With
End Sub