[问题求助] [已解决]VBS如何将TXT文件中的内容按照规律导入EXCEL中？

宫商角徵羽

请问：

Txt 文本中是10000个学生姓名，需要按顺序将每100个学生(为一个班级)放到一个sheet（命名为“一班”）的第一列中（第一行标题命名为“姓名”），做成一个EXCEL，内含100个班级。

如何实现？？    拜谢！！

VBS如果不能实现，请问如何才能实现呢？？:'(

sdulj

回复 6# apang


我在帮助文件中找到如下描述，理解了，谢谢。
描述
返回某字符串在另一字符串中第一次出现的位置。
语法
InStr([start, ]string1, string2[, compare])
InStr 函数的语法有以下参数：

参数 描述
start 可选项。数值表达式，用于设置每次搜索的开始位置。如果省略，将从第一个字符的位置开始搜索。如果 start 包含 Null，则会出现错误。如果已指定 compare，则必须要有 start 参数。
string1 必选项。接受搜索的字符串表达式。
string2 必选项。要搜索的字符串表达式。
compare 可选项。指示在计算子字符串时使用的比较类型的数值。有关数值，请参阅“设置”部分。如果省略，将执行二进制比较。

apang

回复 5# sdulj


if instr(data,",") then
    a=split(data,",")
    ...
end if

sdulj

回复 2# apang


  你好，我有类似的问题，将下面格式的txt文件转换到excel中，我的思路是读取每行，用“，”分割，然后保存到sheet1中。但是老是出错，所以
请教您帮着指导一下。最好能有代码，谢谢。

读取文本文件时就弹出错误了。

我的代码：
Dim a
set fso=CreateObject("Scripting.FileSystemObject")
'获取文件操作对象
set fr=fso.opentextfile("d:\block.dat",1)
'使用文件对象下的opentextfile方法打开文件，设置文件模式为读取

do
data=fr.readline
'按行读取文件

a=split(data,",")
msgbox a(0)
msgbox a(1)

loop until fr.atendofstream
'判断是否达到了文件末尾，如果末尾则退出

宫商角徵羽

【见二楼，已解决，已完美解决】

宫商角徵羽

回复 2# apang


提出这个问题，最后使用EXCEL自带的“数据透视表”功能解决了。

今天试了你的代码，“怎一个赞字了得，要大大的赞赞赞赞啊”

非常感谢！！！
   

apang

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
复制代码