标题: [问题求助] vbs如何读取文本文档数据并汇总? [打印本页]
作者: habiaosuo 时间: 2012-11-30 15:48 标题: 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
目前程序- Const adVarChar = 200
- Const MaxCharacters = 255
- Const ForReading = 1
- Const ForWriting = 2
- Set DataList = CreateObject("ADOR.Recordset")
- DataList.Fields.Append "line", adVarChar, MaxCharacters
- DataList.Open
- Set objFSO = CreateObject("Scripting.FileSystemObject")
- Set objFile = objFSO.OpenTextFile("E:\1.txt", ForReading)
- Do Until objFile.AtEndOfStream
- strLine = objFile.ReadLine
- str_arr=Split (strLine," ")
- For i=0 to ubound(str_arr)
- strLine1=str_arr(i)
- next
- strLine2=str_arr(1)&" "&str_arr(5)
- DataList.AddNew
- DataList("line") = strLine2
- DataList.Update
- Loop
- objFile.Close
- DataList.Sort = "line"
- DataList.MoveFirst
- Do Until DataList.EOF
- strText = strText & DataList.Fields.Item("line") & vbCrLf
- DataList.MoveNext
- Loop
- Set objFile = objFSO.OpenTextFile("E:\2.txt", ForWriting)
- objFile.WriteLine strText
- objFile.Close
复制代码
能实现结果如下
李四 2
李四 3
张三 1
张三 2
张三 3
理想状态是想要实现汇总
即: 李四 5 (2+3)
张三 6 (1+2+3)
恳请各位大侠帮助,无比感谢,在线等结果
作者: habiaosuo 时间: 2012-11-30 15:50
急需实现这段程序,本人能力有限,恳请各位大侠帮忙,无限感激
作者: CrLf 时间: 2012-12-1 00:57
如果是用 gawk 就很方便的了:- gawk "{ar[$2]+=($6)}END{for(a in ar)print a \" \" ar[a]}" 1.txt>2.txt
复制代码
作者: czjt1234 时间: 2012-12-1 13:24
本帖最后由 czjt1234 于 2012-12-1 13:28 编辑
- ReDim ArrName(1,0)
-
- Set objFSO = CreateObject("Scripting.FileSystemObject")
- Set objTextStream = objFSO.OpenTextFile("E:\1.txt", 1)
-
- strLine = objTextStream.ReadLine
- ArrLine = Split(strLine)
- IntName = 0
-
- ArrName(0,0) = ArrLine(1)
- ArrName(1,0) = ArrLine(5)
-
- Do Until objTextStream.AtEndOfStream
- strLine = objTextStream.ReadLine
- ArrLine = Split(strLine)
- blnNew = True
- For i = 0 To IntName
- If ArrName(0,i) = ArrLine(1) Then
- ArrName(1,i) = ArrName(1,i) & "+" & ArrLine(5)
- blnNew = False
- End If
- Next
- If blnNew Then
- IntName = IntName + 1
- ReDim Preserve ArrName(1,IntName)
- ArrName(0,IntName) = ArrLine(1)
- ArrName(1,IntName) = ArrLine(5)
- End If
- Loop
-
- objTextStream.Close
- Set objTextStream = objFSO.OpenTextFile("E:\2.txt", 8, True)
-
- For i = 0 To IntName
- k = 0
- ArrOut = Split(ArrName(1,i), "+")
- For j = 0 To ubound(ArrOut)
- k = k + int(ArrOut(j))
- next
- objTextStream.WriteLine ArrName(0,i) & " " & k & " (" & ArrName(1,i) & ")"
- Next
复制代码
作者: czjt1234 时间: 2012-12-1 13:32
没做容错处理
所以注意要求格式正确,不能有空行,特别是最后一行
作者: caspar 时间: 2012-12-2 15:05
本帖最后由 caspar 于 2012-12-2 15:10 编辑
- Set objDicStr = CreateObject("Scripting.Dictionary")
- Set objDicSum = CreateObject("Scripting.Dictionary")
- Set oFSO = CreateObject("Scripting.FileSystemObject")
-
- str = oFSO.OpenTextFile("Sample.txt").ReadAll
- Set FS = oFSO.CreateTextFile("Result.txt",True)
-
- str = replace(str,vbCrlf," ")
- arrStr= split(str," ")
-
- For t=0 to Ubound(arrStr)
- IF arrStr(t)<>"" Then
- strCheck = mid(arrStr(t),1,1)
- IF ASCW(strCheck) > 122 Then
- IF Not objDicSum.Exists(arrStr(t)) Then
- objDicSum.add arrStr(t), CInt(arrStr(t+4))
- objDicStr.add arrStr(t), arrStr(t+4)
- ELSE
- objDicSum.Item(arrStr(t)) = objDicSum.Item(arrStr(t)) + CInt(arrStr(t+4))
- objDicStr.Item(arrStr(t)) = objDicStr.Item(arrStr(t)) & "+" & arrStr(t+4)
- End IF
- t=t+4
- End IF
- End IF
- Next
-
- Names = objDicSum.keys
-
- For t=0 to Ubound(Names)
- objDicStr.Item(Names(t)) = reOrder(objDicStr.Item(Names(t)))
- FS.WriteLine Names(t) & " " & objDicSum.Item(Names(t)) & " " & objDicStr.Item(Names(t))
- Next
-
- Set FS = Nothing
- Set oFSO = Nothing
- Set objDicSum = Nothing
- Set objDicStr = Nothing
-
-
- Function reOrder(ByVal str)
- Dim Nums() : Redim Nums(Len(str))
- arrTemp = split(str,"+")
-
- For i=0 to Ubound(arrTemp)
- IF arrTemp(i) <> "" Then
- n = n + 1
- Nums(n) = cint(arrTemp(i))
- End IF
- Next
-
- For i=1 to n-1
- For j=i+1 to n
- IF Nums(i)>Nums(j) Then
- Temp=Nums(i)
- Nums(i)=Nums(j)
- Nums(j)=Temp
- End IF
- Next
- Next
-
- outStr = "( "
- For i=1 to n-1
- outStr = outStr & Nums(i) & " + "
- Next
- outStr = outStr & Nums(n) & " )"
-
- reOrder = outStr
-
- End Function
复制代码
作者: zhangop9 时间: 2021-8-1 18:00
读取文本文档数据并汇总
欢迎光临 批处理之家 (http://www.bathome.net/) |
Powered by Discuz! 7.2 |