[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发帖

[问题求助] vbs如何读取文本文档数据并汇总?

文本文档1.txt原始数据格式如下
aa 张三 bb cc dd 1
aa 张三 bb cc dd 2
aa 张三 bb cc dd 3
aa 李四 bb cc dd 2
aa 李四 bb cc dd 3

目前程序
  1. Const adVarChar = 200
  2. Const MaxCharacters = 255
  3. Const ForReading = 1
  4. Const ForWriting = 2
  5. Set DataList = CreateObject("ADOR.Recordset")
  6. DataList.Fields.Append "line", adVarChar, MaxCharacters
  7. DataList.Open
  8. Set objFSO = CreateObject("Scripting.FileSystemObject")
  9. Set objFile = objFSO.OpenTextFile("E:\1.txt", ForReading)
  10. Do Until objFile.AtEndOfStream
  11. strLine = objFile.ReadLine
  12. str_arr=Split (strLine," ")
  13. For i=0 to ubound(str_arr)
  14. strLine1=str_arr(i)
  15. next
  16. strLine2=str_arr(1)&" "&str_arr(5)
  17. DataList.AddNew
  18. DataList("line") = strLine2
  19. DataList.Update
  20. Loop
  21. objFile.Close
  22. DataList.Sort = "line"
  23. DataList.MoveFirst
  24. Do Until DataList.EOF
  25. strText = strText & DataList.Fields.Item("line") & vbCrLf
  26. DataList.MoveNext
  27. Loop
  28. Set objFile = objFSO.OpenTextFile("E:\2.txt", ForWriting)
  29. objFile.WriteLine strText
  30. objFile.Close
复制代码
能实现结果如下

李四 2
李四 3
张三 1
张三 2
张三 3

理想状态是想要实现汇总
即: 李四 5   (2+3)
     张三 6    (1+2+3)
恳请各位大侠帮助,无比感谢,在线等结果

读取文本文档数据并汇总

TOP

本帖最后由 caspar 于 2012-12-2 15:10 编辑
  1. Set objDicStr = CreateObject("Scripting.Dictionary")
  2. Set objDicSum = CreateObject("Scripting.Dictionary")
  3. Set oFSO = CreateObject("Scripting.FileSystemObject")
  4. str = oFSO.OpenTextFile("Sample.txt").ReadAll
  5. Set FS = oFSO.CreateTextFile("Result.txt",True)
  6. str = replace(str,vbCrlf," ")
  7. arrStr= split(str," ")
  8. For t=0 to Ubound(arrStr)
  9.   IF arrStr(t)<>"" Then
  10.      strCheck = mid(arrStr(t),1,1)
  11.      IF ASCW(strCheck) > 122 Then
  12.         IF Not objDicSum.Exists(arrStr(t)) Then
  13.            objDicSum.add arrStr(t), CInt(arrStr(t+4))
  14.            objDicStr.add arrStr(t), arrStr(t+4)
  15.         ELSE
  16.            objDicSum.Item(arrStr(t)) = objDicSum.Item(arrStr(t)) + CInt(arrStr(t+4))
  17.            objDicStr.Item(arrStr(t)) = objDicStr.Item(arrStr(t)) & "+" & arrStr(t+4)
  18.         End IF
  19.         t=t+4
  20.      End IF
  21.    End IF
  22. Next
  23. Names = objDicSum.keys
  24. For t=0 to Ubound(Names)
  25.     objDicStr.Item(Names(t)) = reOrder(objDicStr.Item(Names(t)))
  26.     FS.WriteLine Names(t) & " " & objDicSum.Item(Names(t)) & " " & objDicStr.Item(Names(t))
  27. Next
  28. Set FS = Nothing
  29. Set oFSO = Nothing
  30. Set objDicSum = Nothing
  31. Set objDicStr = Nothing
  32. Function reOrder(ByVal str)
  33.   Dim Nums() : Redim Nums(Len(str))
  34.   arrTemp = split(str,"+")
  35.   For i=0 to Ubound(arrTemp)
  36.       IF arrTemp(i) <> "" Then
  37.          n = n + 1
  38.          Nums(n) = cint(arrTemp(i))
  39.       End IF
  40.   Next
  41.   For i=1 to n-1
  42.     For j=i+1 to n
  43.       IF Nums(i)>Nums(j) Then
  44.          Temp=Nums(i)
  45.          Nums(i)=Nums(j)
  46.          Nums(j)=Temp
  47.       End IF
  48.     Next
  49.   Next
  50.   
  51.   outStr = "( "
  52.   For i=1 to n-1
  53.     outStr = outStr & Nums(i) & " + "
  54.   Next
  55.   outStr = outStr & Nums(n) & " )"
  56.   reOrder = outStr
  57. End Function
复制代码

TOP

没做容错处理

所以注意要求格式正确,不能有空行,特别是最后一行

QQ 20147578

TOP

本帖最后由 czjt1234 于 2012-12-1 13:28 编辑

  1. ReDim ArrName(1,0)
  2. Set objFSO = CreateObject("Scripting.FileSystemObject")
  3. Set objTextStream = objFSO.OpenTextFile("E:\1.txt", 1)
  4. strLine = objTextStream.ReadLine
  5. ArrLine = Split(strLine)
  6. IntName = 0
  7. ArrName(0,0) = ArrLine(1)
  8. ArrName(1,0) = ArrLine(5)
  9. Do Until objTextStream.AtEndOfStream
  10.     strLine = objTextStream.ReadLine
  11.     ArrLine = Split(strLine)
  12.     blnNew = True
  13.     For i = 0 To IntName
  14.         If ArrName(0,i) = ArrLine(1) Then
  15.             ArrName(1,i) = ArrName(1,i) & "+" & ArrLine(5)
  16.             blnNew = False
  17.         End If
  18.     Next
  19.     If blnNew Then
  20.         IntName = IntName + 1
  21.         ReDim Preserve ArrName(1,IntName)
  22.         ArrName(0,IntName) = ArrLine(1)
  23.         ArrName(1,IntName) = ArrLine(5)
  24.     End If
  25. Loop
  26. objTextStream.Close
  27. Set objTextStream = objFSO.OpenTextFile("E:\2.txt", 8, True)
  28. For i = 0 To IntName
  29.     k = 0
  30.     ArrOut = Split(ArrName(1,i), "+")
  31.     For j = 0 To ubound(ArrOut)
  32.         k = k + int(ArrOut(j))
  33.     next
  34.     objTextStream.WriteLine ArrName(0,i) & " " & k & " (" & ArrName(1,i) & ")"
  35. Next
复制代码

QQ 20147578

TOP

如果是用 gawk 就很方便的了:
  1. gawk "{ar[$2]+=($6)}END{for(a in ar)print a \" \" ar[a]}" 1.txt>2.txt
复制代码

TOP

急需实现这段程序,本人能力有限,恳请各位大侠帮忙,无限感激

TOP

返回列表