1

Тема: VBS:Подсчет количества совпадающих строк в файле

Всем привет, есть файл вида, например:
таня
дима
света
таня
толя
оля
света
иван
дима
таня

итд
надо подсчитать сколько раз повторяется каждая подстрока, и записать результат в др.файл
Т.е надо прочитать строку, сравнить ее с каждой из остальных, удалить совпадающие, подсчитать кол-во совпадающих строк и записать результат в другой файл. И так со всеми строками
 
Просто найти известную подстроку, подсчитать, удалить и записать результат в др.файл я могу

word = "таня" 				'искомое слово
papka = "c:\0\"			'папка поиска
output= papka&"отчет\"			'папка output
output_txt = output&"отчет.txt"		'файл отчета

i=0  'счетчик файлов


Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objRegExp = CreateObject("VBScript.RegExp")
If not objFSO.FolderExists(output) Then objFSO.CreateFolder output          'создаем output

objRegExp.IgnoreCase = True
Set file2 = objFSO.OpenTextFile(output_txt, 2, True) 


RecursiveFolderScan papka
file2.close

Msgbox "ВСЕ! Обработано "& i &" файлов"


 Sub RecursiveFolderScan(FolderPath)
    'Получаем объектную модель текущего каталога
    Set Folder = objFSO.GetFolder(FolderPath)
 
    'Перебираем все файлы в текущем каталоге
    For Each File in Folder.Files
'+++++++++++++++++++++++++++++++++++++++++

Set file1 = objFSO.OpenTextFile(File, 1, False)  'читаем файл
boolFound = False
z=0  'счетчик подстрок
       Do Until file1.AtEndOfStream
            sw = file1.ReadLine() 'по-строчно
            If InStr(1, sw, word) <> 0 Then z=z+1
        Loop
                file2.WriteLine(file.Name) 'пишем в отчет имя файла      
                file2.WriteLine(sw&" повторяется "&z&" раз") 'пишем в отчет всю строку
        file1.close 'закрываем файл

     

            Set file1 = objFSO.OpenTextFile(File, 1, False) 'снова читаем тот же файл
            strText = file1.ReadAll 'читаем все содержимое в переменную            
            file1.close 'и опять закрываем
            'меняем все вхождения найденной строки на пробел - а надо наверное искомого слова - word
            strNewText = Replace(strText, sw, " ")             
 
            'снова открываем тот же файл - на этот раз для записи - таким образом удаляя все содержимое файла
            Set file1 = objFSO.OpenTextFile(File, 2, False)
            file1.WriteLine strNewText 'пишем новое содержимое
            file1.close 'и закрываем в третий раз
  



i=i+1        'счетчик файлов
'++++++++++++++++++++++++++++++++++++++

    Next

End Sub

А вот прочитать строку и сравнить ее с каждой из остальных и потом проделать это со всеми оставшимися строками пока не закончаться все строки - как это сделать мне не понятно.

2 (изменено: Rumata, 2018-09-29 12:47:22)

Re: VBS:Подсчет количества совпадающих строк в файле

Идея заключается в следующем:
1. сортировка внешней командой SORT
2. скриптом VBScript или JScript читать вывод предыдущей команды SORT
3. сравнивать текущую строку с предыдущей
3.1. если строки одинаковые -- считать количество
3.2. если строки разные выводить предыдущую и ее количество
4. повторять с пункта 3 для каждой последующей строки

Здесь есть два граничных "условия":
1. в начале файла -- нет предыдущей строки
2. в конце файла -- список кончился, но последнюю строку еще не вывели.

Если для Вас не принципиален язык (JS или VBS), приведу пример на JS

line_count.js


// предыдущая строка и количество одинаковых строк
var prev;
var count;

// печатать количество и строку
function print() {
	if ( count ) {
		WScript.StdOut.WriteLine(count + ":" + prev);
	}
}

while ( ! WScript.StdIn.AtEndOfStream ) {
	var line = WScript.StdIn.ReadLine();

	// считать количество одинаковых строк
	if ( line === prev ) {
		count++;
		continue;
	}

	// печатать количество и строку (предыдущий блок одинаковых строк)
	print();

	// сбросить счетчики
	count = 1;
	prev = line;
}

// печатать количество и строку (последний блок одинаковых строк)
print();

line_count.bat


@sort | cscript //nologo line_count.js

Способ применения:


line_count.bat [< INPUTFILE] [> OUTPUTFILE]
( 2 * b ) || ! ( 2 * b )

3

Re: VBS:Подсчет количества совпадающих строк в файле

Большое спасибо! Язык не принципиален. Только на JS я не умею записывать результат в файл. Как это сделать?

4

Re: VBS:Подсчет количества совпадающих строк в файле

Предоставьте это сделать системе - пусть она все сделает сама.

Я немного поправил свое предыдущее сообщение:
-- изменил код скрипта line_count.bat
-- соответственно этому изменил способ применения

От этого всё стало гибче. Теперь можно читать из файла или потока другой программы, писать в файл или поток другой программы. Примеры:


:: прочитать один файл
:: обработать
:: записать в другой
line_count.bat < INPUTFILE > OUTPUTFILE

:: прочитать результат одной команды
:: обработать
:: записать в файл
command1 | line_count.bat > OUTPUTFILE

:: прочитать файл
:: обработать
:: результат передать другой команде
line_count.bat < INPUTFILE | command2

:: прочитать результат одной команды
:: обработать
:: результат передать другой команде
command1 | line_count.bat | command2
( 2 * b ) || ! ( 2 * b )

5 (изменено: alexii, 2018-09-29 12:56:48)

Re: VBS:Подсчет количества совпадающих строк в файле

Option Explicit

Dim strSourceFile
Dim strDestFile

Dim objFSO
Dim objDictionary

Dim arrContent

Dim strValue
Dim strKey


If WScript.Arguments.Count = 1 Then
	strSourceFile = WScript.Arguments.Item(0)
	
	Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
	
	If objFSO.FileExists(strSourceFile) Then
		strDestFile = objFSO.BuildPath(objFSO.GetParentFolderName(strSourceFile), objFSO.GetBaseName(strSourceFile) & "_Counts.csv")
		
		Set objDictionary = WScript.CreateObject("Scripting.Dictionary")
		
		With objFSO.OpenTextFile(strSourceFile)
			arrContent = Split(.ReadAll(), vbCrLf)
			.Close
		End With
		
		For Each strValue In arrContent
			If Not objDictionary.Exists(strValue) Then
				objDictionary.Add strValue, 1
			Else
				objDictionary.Item(strValue) = objDictionary.Item(strValue) + 1
			End If
		Next
		
		With objFSO.CreateTextFile(strDestFile, True)
			For Each strKey In objDictionary.Keys
				WScript.Echo strKey, vbTab, objDictionary.Item(strKey)
				.WriteLine strKey & "," & objDictionary.Item(strKey)
			Next
			
			.Close
		End With
		
		Set objDictionary = Nothing
	Else
		WScript.Echo "Can't find source file [" & strSourceFile & "]."
		WScript.Quit 2
	End If
	
	Set objFSO = Nothing
Else
	WScript.Echo "Usage: cscript.exe //nologo """ & WScript.ScriptName & """ <Source file>"
	WScript.Quit 1
End If

WScript.Quit 0

Путь к исходному файлу указывается параметром скрипта (также можно просто перетащить исходный файл на скрипт в Проводнике). Результирующий файл будет иметь имя исходного файла + "_Counts" и расширение ".csv".

В случае, если исходный файл имеет солидные размеры, можно подумать про использование OLE DB.

6

Re: VBS:Подсчет количества совпадающих строк в файле

Rumata, alexii  огромное спасибо за код.
alexii, строка WScript.Echo strKey, vbTab, objDictionary.Item(strKey)  -  вывод в MessageBox'ов явно лишнее (я заиб*лся их закрывать)

7 (изменено: alexii, 2018-09-29 23:30:39)

Re: VBS:Подсчет количества совпадающих строк в файле

griha09, пользуйте cscript.exe по умолчанию вместо wscript.exe — и будет Вам счастье :

+ открыть спойлер

https://i.imgur.com/n7rmFYl.png

8

Re: VBS:Подсчет количества совпадающих строк в файле

Решил тоже немного поучаствовать.
counter.vbs


Option Explicit
Dim oStdIn, oStdOut, oDict, sValue
'Получение объекта для работы с файловой системой (но в данном случае для получения доступа к входящему и выходному потоку)
With CreateObject("Scripting.FileSystemObject")
	'Получение входящего потока
	Set oStdIn = .GetStandardStream(0)
	'Получение выходного потока
	Set oStdOut = .GetStandardStream(1)
End With
'Создание коллекции для накопления результатов
Set oDict = CreateObject("Scripting.Dictionary")
'Включение текстового режима сравнения строк для игнорирования регистра символов (На случай "Таня" и "таня")
oDict.CompareMode = 2
'Получение строк из входящего потока
While Not oStdIn.AtEndOfStream
	'Чтение строки из потока
	sValue = Trim(oStdIn.ReadLine)
	'Накопление результата
	If sValue <> "" Then oDict(sValue) = oDict(sValue) + 1
Wend
'Вывод результатов подсчёта в выходной поток
For Each sValue in oDict.Keys
	'Вывод результатов подсчёта обратно в поток
	oStdOut.WriteLine sValue & ": " & oDict(sValue)
Next

test.cmd


@echo off
cscript //NOLOGO counter.vbs < data.txt > result.txt
pause

(!) Для запуска нужен data.txt с записями в том же каталоге

Хотел использовать WSH.StdIn и WSH.StdOut, но при этом не нашёл как настроить кодировку потоков, из-за этого ANSI файлы неправильно читались. Поэтому использовал GetStandardStream. Но наверняка как-то можно обойтись и без него.

Передумал переделывать мир. Пашет и так, ну и ладно. Сделаю лучше свой !

9

Re: VBS:Подсчет количества совпадающих строк в файле

Xameleon пишет:
'Включение текстового режима сравнения строк для игнорирования регистра символов (На случай "Таня" и "таня")
oDict.CompareMode = 2

Вот, кстати, да. А я забыл про сё .

10

Re: VBS:Подсчет количества совпадающих строк в файле

alexii

alexii пишет:

Вот, кстати, да. А я забыл про сё .

Ну судя по всему у топикстатера это проблем не вызвало. ) А не подскажете как пофиксить проблемку с кодировкой у WSH.StdIn и WSH.StdOut ? Мне для личного опыта.

Передумал переделывать мир. Пашет и так, ну и ладно. Сделаю лучше свой !

11 (изменено: alexii, 2018-09-30 21:04:22)

Re: VBS:Подсчет количества совпадающих строк в файле

А что с ними не так? У меня вроде бы читают входной файл, переданный на вход stdin, как ANSI, и в ней же делают вывод в stdout. Что сscript.exe, что wscript.exe.

12

Re: VBS:Подсчет количества совпадающих строк в файле

alexii, действительно. Сейчас переписал скрипт и с кодировкой вроде бы всё нормально. Странно. До этого получал искажения.


Option Explicit
Dim oDict, sValue
'Создание коллекции для накопления результатов
Set oDict = CreateObject("Scripting.Dictionary")
'Включение текстового режима сравнения строк для игнорирования регистра символов (На случай "Таня" и "таня")
oDict.CompareMode = 2
'Получение строк из входящего потока
While Not WSH.StdIn.AtEndOfStream
	'Чтение строки из потока
	sValue = Trim(WSH.StdIn.ReadLine)
	'Накопление результата
	If sValue <> "" Then oDict(sValue) = oDict(sValue) + 1
Wend
'Вывод результатов подсчёта в выходной поток
For Each sValue in oDict.Keys
	'Вывод результатов подсчёта обратно в поток
	WSH.StdOut.WriteLine sValue & ": " & oDict(sValue)
Next
Передумал переделывать мир. Пашет и так, ну и ладно. Сделаю лучше свой !