caspar

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