Автор: SAS888
Дата сообщения: 03.11.2009 06:01
Pozitivchik
Можно, например, так:
Код: Sub Main()
Dim Filename As String, txt As String, i As Long, j As Long, n As Integer, a(), arr, x
Application.ScreenUpdating = False
'Получаем имя текстового файла.
Filename = Application.GetOpenFilename(, , , "Выберите файл для обработки", "Открыть")
If Filename = "" Then Exit Sub
'Задаем количество символов
n = InputBox("Количество символов", "Поиск слов")
'Считываем весь файл в переменную txt.
Set fso = CreateObject("scripting.filesystemobject")
Set ts = fso.OpenTextFile(Filename, 1, True): txt = ts.ReadAll: ts.Close
'Убираем непечатные символы и лишние пробелы.
txt = Replace(txt, Chr(10), " "): txt = Replace(txt, Chr(13), " "): txt = Application.Trim(txt)
'Формируем массив всех слов.
arr = Split(txt, " "): ReDim a(1 To UBound(arr) + 1): j = 0
'Выбираем в другой массив все слова длиной в n символов.
For i = LBound(arr) To UBound(arr)
If Len(arr(i)) = n Then
j = j + 1: a(j) = arr(i)
End If: Next
If j = 0 Then Exit Sub Else ReDim Preserve a(1 To j)
'Сортируем массив
For i = LBound(a) To UBound(a) - 1
For j = i + 1 To UBound(a)
If a(i) > a(j) Then
x = a(i): a(i) = a(j): a(j) = x
End If: Next: Next
'Выводим результат в столбец "A".
Range([A1], Cells(UBound(a), 1)).Value = Application.Transpose(a)
End Sub
. 
