Dim path, fso, txt, oExcel, oBook, oSheet
path = Left(WScript.ScriptFullName,InStrRev(WScript.ScriptFullName,"\"))
Set fso = CreateObject("Scripting.FileSystemObject")
txt = fso.OpenTextFile("学生姓名.txt").ReadAll
Set fso = Nothing

Set oExcel = CreateObject("Excel.Application")
oExcel.Visible = false
Set oBook = oExcel.WorkBooks.Add

Dim re, i, m, ar, j
Set re = New RegExp
re.Pattern = "(.*\n){100}|[\s\S]+$"
re.Global = True
For i = re.Execute(txt).Count-1 to 0 Step -1
    m = re.Execute(txt)(i)
    ar = Split("姓名" & vbCrLf & m,vbCrLf)
    Set oSheet = oBook.WorkSheets.Add
    oSheet.Name = myfun("00" & (i+1)) & "班"
    For j = 0 to UBound(ar)
        oExcel.Cells(j+1,1) = ar(j)
    Next
    Set oSheet = Nothing
Next
oBook.SaveAs(path & "Result.xls"),1
oExcel.WorkBooks.Close
oExcel.Quit
Set oExcel = Nothing
Set oBook = Nothing

MsgBox "OK"

Function myfun(x)
    Dim a
    x = Right(x,3)
    a = Array("〇","一","二","三","四","五","六","七","八","九")
    x = a(Mid(x,1,1)) & "百" & a(Mid(x,2,1)) & "十" & a(Mid(x,3))
    x = Replace(Replace(x,"〇百〇十",""),"〇百","")
    x = Replace(Replace(x,"〇十〇",""),"〇十","〇")
    myfun = Replace(x,"十〇","十")
End Function
复制代码