<p>试试这个VBA宏。它使用正则表达式来解析不同的段;但是如果数据不是您所呈现的方式,那么它将失败;因此,如果出现失败,您需要了解它是如何与我的假设或您呈现数据的方式不匹配的。你知道吗</p>
<p>宏假定数据从A1开始,在A列中,第1行中没有标签。结果被写入B列和后续列;带有标签行1,但这些结果可以放在任何地方。你知道吗</p>
<p>此代码进入常规模块。你知道吗</p>
<pre><code>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
</code></pre>