Board logo

标题: [问题求助] [已解决]VBS如何将TXT文件中的内容按照规律导入EXCEL中? [打印本页]

作者: 宫商角徵羽    时间: 2014-2-13 13:17     标题: [已解决]VBS如何将TXT文件中的内容按照规律导入EXCEL中?

请问:

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

如何实现??    拜谢!!

VBS如果不能实现,请问如何才能实现呢??:'(
作者: apang    时间: 2014-2-13 22:51

本帖最后由 apang 于 2014-2-14 11:38 编辑
  1. Dim path, fso, txt, oExcel, oBook, oSheet
  2. path = Left(WScript.ScriptFullName,InStrRev(WScript.ScriptFullName,"\"))
  3. Set fso = CreateObject("Scripting.FileSystemObject")
  4. txt = fso.OpenTextFile("学生姓名.txt").ReadAll
  5. Set fso = Nothing
  6. Set oExcel = CreateObject("Excel.Application")
  7. oExcel.Visible = false
  8. Set oBook = oExcel.WorkBooks.Add
  9. Dim re, i, m, ar, j
  10. Set re = New RegExp
  11. re.Pattern = "(.*\n){100}|[\s\S]+$"
  12. re.Global = True
  13. For i = re.Execute(txt).Count-1 to 0 Step -1
  14.     m = re.Execute(txt)(i)
  15.     ar = Split("姓名" & vbCrLf & m,vbCrLf)
  16.     Set oSheet = oBook.WorkSheets.Add
  17.     oSheet.Name = myfun("00" & (i+1)) & "班"
  18.     For j = 0 to UBound(ar)
  19.         oExcel.Cells(j+1,1) = ar(j)
  20.     Next
  21.     Set oSheet = Nothing
  22. Next
  23. oBook.SaveAs(path & "Result.xls"),1
  24. oExcel.WorkBooks.Close
  25. oExcel.Quit
  26. Set oExcel = Nothing
  27. Set oBook = Nothing
  28. MsgBox "OK"
  29. Function myfun(x)
  30.     Dim a
  31.     x = Right(x,3)
  32.     a = Array("〇","一","二","三","四","五","六","七","八","九")
  33.     x = a(Mid(x,1,1)) & "百" & a(Mid(x,2,1)) & "十" & a(Mid(x,3))
  34.     x = Replace(Replace(x,"〇百〇十",""),"〇百","")
  35.     x = Replace(Replace(x,"〇十〇",""),"〇十","〇")
  36.     myfun = Replace(x,"十〇","十")
  37. End Function
复制代码

作者: 宫商角徵羽    时间: 2014-3-13 09:24

回复 2# apang


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

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

非常感谢!!!
   

作者: 宫商角徵羽    时间: 2014-3-13 09:25

【见二楼,已解决,已完美解决】
作者: sdulj    时间: 2014-3-30 09:27

回复 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
'判断是否达到了文件末尾,如果末尾则退出
作者: apang    时间: 2014-3-30 16:07

回复 5# sdulj


if instr(data,",") then
    a=split(data,",")
    ...
end if
作者: sdulj    时间: 2014-3-30 20:34

回复 6# apang


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

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




欢迎光临 批处理之家 (http://www.bathome.net/) Powered by Discuz! 7.2