[amel27]

Код:

Set dic = CreateObject("Scripting.Dictionary")
Set fso = CreateObject("Scripting.FileSystemObject")

Set fi1 = fso.OpenTextFile("file1.txt", 1)
Set fi2 = fso.OpenTextFile("file2.txt", 2, vbTrue)

While Not fi1.AtEndOfStream
  str = fi1.ReadLine
  If dic.Exists(str) Then
    dic.Item(str)=dic.Item(str)+1
  ElseIf Not Left(str,1)="#" Then
    dic.Add str, 1
  End If
Wend

For Each key In dic
  If dic.Item(key) > 1 Then
    fi2.WriteLine Mid(key,InStrRev(key," "))*dic.Item(key)
  End If
Next

fi1.Close
fi2.Close

[Nastasya]

спасибо большое, но она почему-то не правильно считает((((

Ой, простите, все правильно!!а не подскажите еще как сделать так, чтобы он суммировал все строчки начинающиеся с paint, затем все строчки, начинающиеся с calc.А в файл бы выводилось- paint сумма
calc сумма
Буду премного благодарна!

[amel27]

Код:

Set dic = CreateObject("Scripting.Dictionary")
Set fso = CreateObject("Scripting.FileSystemObject")

Set fi1 = fso.OpenTextFile("file1.txt", 1)
Set fi2 = fso.OpenTextFile("file2.txt", 2, vbTrue)

While Not fi1.AtEndOfStream
  str = Trim(fi1.ReadLine)
  cnt = Int(Mid(str,InStrRev(str," ")+1))
  str = Mid(str,1,InStr(str," ")-1)
  If dic.Exists(str) Then
    dic.Item(str)=cnt+dic.Item(str)
  ElseIf Not Left(str,1)="#" Then
    dic.Add str, cnt
  End If
Wend

For Each key In dic
  fi2.WriteLine key & vbTab & dic.Item(key)
Next

fi1.Close
fi2.Close

[Nastasya]

Спасибо огромнейшее!!!!