Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Алтайский край - отчет.doc
Скачиваний:
11
Добавлен:
01.07.2025
Размер:
510.98 Кб
Скачать
    1. Экспорт обработанных данных из файлов txt в Excel

'Цифры от 1 до 49 для программы AddFile

Sub AddAll()

For i = 1 To 49

AddFile (i)

Next i

End Sub

'Программа из созданных в программе Mystem файлов переносит каждое слово в отдельную ячейку

Sub AddFile(N)

num = Trim(Str(N))

'Заносит все слова в столбец из файла с передачей двух параметров: ссылкой на файла и ссылка на столбец (с помощью языка Query)

With ActiveSheet.QueryTables.Add(Connection:= _

"TEXT;C:\Users\123\Desktop\Project\textanalisis\InformationTXT\info" + num + "_res.txt", Destination:=Sheets("Table").Cells(2, N))

.Name = "info" + num + "_res"

.FieldNames = True

.RowNumbers = False

.FillAdjacentFormulas = False

.PreserveFormatting = True

.RefreshOnFileOpen = False

.RefreshStyle = xlInsertDeleteCells

.SavePassword = False

.SaveData = True

.AdjustColumnWidth = True

.RefreshPeriod = 0

.TextFilePromptOnRefresh = False

.TextFilePlatform = 1251

.TextFileStartRow = 1

.TextFileParseType = xlDelimited

.TextFileTextQualifier = xlTextQualifierDoubleQuote

.TextFileConsecutiveDelimiter = False

.TextFileTabDelimiter = True

.TextFileSemicolonDelimiter = False

.TextFileCommaDelimiter = False

.TextFileSpaceDelimiter = False

.TextFileColumnDataTypes = Array(1)

.TextFileTrailingMinusNumbers = True

.Refresh BackgroundQuery:=False

End With

'Далее вручную знаки вопроса заменяются на пробел при помощи Excel, причем поскольку знак вопроса - это служебный знак, то перед ним в графе "найти" ставим знак тильды

End Sub

    1. Сортировка и удаление дубликатов

Sub RemoveDuble()

For i = 1 To 49

ActiveSheet.Range(Cells(1, i), Cells(200, i)).RemoveDuplicates Columns:=1, Header:=xlYes

Next i

End Sub

'Сортировка по алфавиту

Sub Макрос2()

For i = 1 To 49

'Выбор конкретного столбца

Range(Cells(1, i), Cells(200, i)).Select

'Очистка любой сортировки, которая могла быть до этого

ActiveWorkbook.Worksheets("Лист1").Sort.SortFields.Clear

'Сортировка по параметрам значения (т.е. алфивиту)

ActiveWorkbook.Worksheets("Лист1").Sort.SortFields.Add Key:=Range(Cells(2, i), Cells(2, i)), _

SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

'Дальнейшие параметры сортированного текста

With ActiveWorkbook.Worksheets("Лист1").Sort

.SetRange Range(Cells(1, i), Cells(200, i))

.Header = xlNo

.MatchCase = False

.Orientation = xlTopToBottom

.SortMethod = xlPinYin

.Apply

End With

Next i

End Sub

'Фактически оба эти действия можно сделать с использованием обычных инструментов Эксель, но с целью автоматизации иногда удодобнее писать код

    1. Составление единого столбца из всех слов

Sub AllWords()

k = 1

'Цикл по столбцам

For i = 1 To 49

'Цикл по строкам

For j = 2 To 200

Sheets(3).Cells(k, 1) = Sheets(1).Cells(j, i)

k = k + 1

Next j

Next i

End Sub

'Считаем, сколько раз считается конкретное слово в каждом источнике при помощь функции СЧЕТЕСЛИ