[原创]取学生姓名和成绩

[个人原创，如转载请说明出处]
昨天csdn bbs上有人发帖问取一段文本中学生姓名和成绩的问题。
看了看，确实数据没有什么规律。

'这里是设置的数据（略有改动）
xuesheng = "林川瑜 04财（2）班 川俊青74-63 全年.川倩倩 91，89" & vbCrLf & _
"川文欢 86，81,69 川复兴68 78 卢川燕 90,92, 王川倩" & vbCrLf & _
"72,85" & vbCrLf & _
"英（1）班 川煜炯 88,96川凯捷 男" & vbCrLf & _
"朱川钧 86 川宪珍 84,80, 李川翔 85 川清 82 李川友 79 川" & vbCrLf & _
"昌 82 韩芝川云 84" & vbCrLf & _
"王川 86 刘川玫 82 川萍 81 付川 78 川永新 85,90 戚川庆" & vbCrLf & _
"70,80 蒋川 89" & vbCrLf & _
"川红川 85 期中 川铮 85 张川元 84 姚川 87 王川 86,78" & vbCrLf & _
"川力 83 王立建 79 川宇 85 龚川娟 86 王川立 78 川岩 72 牛" & vbCrLf & _
"川慧 89 82"
Text1.Text = xuesheng

采用了以下方法：
1、替换其中的换行符和英文逗号
cj = Text1.Text
cj = Replace(cj, vbCrLf, " ")
cj = Replace(cj, ",", " ")

2、部分关键字过滤
Text2.Text = "04财（2）班,全年,英（1）班,期中,，,-,., 男 "
If Trim(Text2.Text) <> "" Then
Dim tihuan_array() As String
tihuan_array = Split(Text2.Text, ",")
For i = 0 To UBound(tihuan_array)
cj = Replace(cj, tihuan_array(i), " ")
Next
End If

3、'替换2个空格为1个
cj = Replace(cj, ",", "")
Do While InStr(cj, " ")
cj = Replace(cj, " ", " ")
Loop

4、开始转换

Dim xmcj_array() As String
xmcj_array = Split(cj, " ")

Dim xmcj_sub As String
xmcj_sub = ""
For i = 0 To UBound(xmcj_array)
If IsNumeric(xmcj_array(i)) Then '如果是数字
xmcj_sub = xmcj_sub & " " & xmcj_array(i)
If i = UBound(xmcj_array) Then
List1.AddItem xiuzheng(xmcj_sub) '修正并显示数据
End If
Else
If Len(xmcj_sub) > 1 Then
List1.AddItem xiuzheng(xmcj_sub) '修正并显示数据
xmcj_sub = xmcj_array(i)
Else
xmcj_sub = xmcj_sub & xmcj_array(i)
End If
End If

Next

End Sub

5、修正姓名长度，使分数对齐
Private Function xiuzheng(xmcj1 As String) As String
Dim k As Integer

Dim tmpa() As String
tmpa = Split(xmcj1, " ")
xiuzheng = ""
For k = 0 To UBound(tmpa)
If k = 0 Then
xiuzheng = xiuzheng2(tmpa(0))
If Len(xiuzheng) = 2 Then xiuzheng = xiuzheng & " " '不需要修正就删除
Else
xiuzheng = xiuzheng & " " & tmpa(k)
End If
Next

End Function

6、修正姓名连接分数的情况
Private Function xiuzheng2(ByVal xmcj2 As String) As String
Dim l As Integer
Dim xm As String, cj As String
xm = "": cj = ""
For l = 1 To Len(xmcj2)
If Asc(Mid(xmcj2, l, 1)) < 0 Then
xm = xm & Mid(xmcj2, l, 1)
Else
cj = cj & Mid(xmcj2, l, 1)
End If
Next
If Len(cj) > 0 Then xiuzheng2 = xm & " " & cj Else xiuzheng2 = xm
End Function

完工，也许还有更好的方法！