Option Explicit
Sub demo()
Dim i As Long, j As Long, k As Long, s As String
Dim reg1 As Object, matches1 As Object, mch1 As Object
Dim reg2 As Object, matches2 As Object, mch2 As Object
Dim allBonus As String
i =6
s = Range("a1").Value
Set reg1 = CreateObject("vbscript.regexp")
reg1.Global =True
reg1.Pattern ="姓名:\s*(\S+)\s*获奖情况:([^;]+);"
Set reg2 = CreateObject("vbscript.regexp")
reg2.Global =True
reg2.Pattern ="\s*(\S+)奖(\S+)"
Set matches1 = reg1.Execute(s)
For Each mch1 In matches1
Cells(i,2)= mch1.submatches(0)
allBonus = Trim(mch1.submatches(1))
Set matches2 = reg2.Execute(allBonus)
For Each mch2 In matches2
For k =3 To 6
If Cells(5, k)= mch2.submatches(0) Then
Cells(i, k)= mch2.submatches(1)
End If
Next k
Next mch2
i = i +1
Next mch1
End Sub