корректура тхт

[Old_Man_nsk]

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

Function Repl(Stroka As String, WordStart As String, WordFinish As String) As String
Dim Score As Integer
Score = 1
While Score <> 0
Score = InStr(Score, Stroka, WordStart, 1)
If Score <> 0 Then
Stroka = Mid(Stroka, 1, Score - 1) + WordFinish + Mid(Stroka, Score + Len(WordStart), Len(Stroka) - Score - Len(WordStart) + 1)
Score = Score + Len(WordFinish)
End If
Wend
Repl = Stroka
End Function


Sub корректир()
Dim Stroka As String
Dim WordStart As String
Dim WordFinish As String
Dim I As Long
Dim J As Long
Dim K As Long
Dim NumberString As Long
Dim Data() As String
'Подсчет количества строк
Open "C:\Documents and Settings\John\Рабочий стол\Чистка\Техт.txt" For Input As #1
NumberString = 0
Do While Not EOF(1)
Line Input #1, Stroka
NumberString = NumberString + 1
Loop
Close #1
ReDim Data(1 To NumberString)
'Считывание строк
Open "C:\Documents and Settings\John\Рабочий стол\Чистка\Техт.txt" For Input As #2
NumberString = 0
Do While Not EOF(2)
Line Input #2, Stroka
NumberString = NumberString + 1
Data(NumberString) = Stroka
Loop
Close #2
'Удаление пробелов в начале и конце
For I = 1 To NumberString
Data(I) = LTrim(RTrim(Data(I)))
Next I
'********************************** *********************************** *********************
For I = 1 To NumberString
'Удаление лишних пробелов
For J = 1 To 10
WordStart = " "
WordFinish = " "
Data(I) = Repl(Data(I), WordStart, WordFinish)
Next J
'Удаление пробелов перед запятыми
WordStart = " ,"
WordFinish = ","
Data(I) = Repl(Data(I), WordStart, WordFinish)
'Пробелы окружающие дефис
WordStart = " -"
WordFinish = "-"
Data(I) = Repl(Data(I), WordStart, WordFinish)
WordStart = "- "
WordFinish = "-"
Data(I) = Repl(Data(I), WordStart, WordFinish)
'Пробелы окружающие плюс
WordStart = " +"
WordFinish = "+"
Data(I) = Repl(Data(I), WordStart, WordFinish)
WordStart = "+ "
WordFinish = "+"
Data(I) = Repl(Data(I), WordStart, WordFinish)....

буду очень признателен.
icq 479 991 875

old-man46@yandex.ru

[EducatedFool]

Вот так намного проще и быстрее:

Function ReplaceAll(ByVal Stroka As String, ByVal WordStart As String, ByVal WordFinish As String) As String
    While InStr(1, Stroka, WordStart) > 0
        Stroka = Replace(Stroka, WordStart, WordFinish)
    Wend
    ReplaceAll = Stroka
End Function

Sub Корректировка()
    Filename = "C:\Documents and Settings\John\Рабочий стол\Чистка\Техт.txt"
    Filename = "C:\Documents and Settings\Игорь\Рабочий стол\Текстовый документ.txt" ' для проверки

    Set ts = CreateObject("scripting.filesystemobject").OpenTextFile(Filename, 1, False)
    txt = ts.Readall: ts.Close    ' считываем файл в переменную txt

    txt = ReplaceAll(txt, "  ", " ")    'Удаление лишних пробелов

    СимволыБезПробелов = "+-*/$#&="
    For I = 1 To Len(СимволыБезПробелов)    'Убираем Пробелы, окружающие СимволыБезПробелов
        Символ = Mid$(СимволыБезПробелов, I, 1)
        txt = Replace(txt, " " & Символ, Символ)
        txt = Replace(txt, Символ & " ", Символ)
    Next I

    arr = Split(txt, vbNewLine)    ' разбиваем на строки - получаем массив
    If Not IsArray(arr) Then Exit Sub

    For I = LBound(arr) To UBound(arr)
        arr(I) = Trim$(arr(I))    'Удаление пробелов в начале и конце каждой строки
    Next I

    For Each s In arr
        Debug.Print s    ' вывод строк в окно отладки
    Next
End Sub

[EducatedFool]

Или даже так: (без лишних функций)

Sub Корректировка()
    Filename = "C:\Documents and Settings\John\Рабочий стол\Чистка\Техт.txt"

    Set ts = CreateObject("scripting.filesystemobject").OpenTextFile(Filename, 1, False)
    txt = ts.Readall: ts.Close    ' считываем файл в переменную txt

    While InStr(1, txt, "  ") > 0: txt = Replace(txt, "  ", " "): Wend    'Удаление лишних пробелов

    СимволыБезПробелов = "+-*/$#&="
    For I = 1 To Len(СимволыБезПробелов)    'Убираем Пробелы, окружающие СимволыБезПробелов
        Символ = Mid$(СимволыБезПробелов, I, 1)
        txt = Replace(txt, " " & Символ, Символ)
        txt = Replace(txt, Символ & " ", Символ)
    Next I

    txt = Replace(txt, " " & vbNewLine, vbNewLine)    'Удаление пробелов в начале каждой строки
    txt = Replace(txt, vbNewLine & " ", vbNewLine)    'Удаление пробелов в конце каждой строки

    Debug.Print txt    ' вывод файла в окно отладки
End Sub

Сообщение от Sasha_Smirnov

Но в сканированных текстах и три пробела не редкость!

При внимательном изучении кода ты заметишь, что и три, и триста пробелов подряд заменятся на один пробел:

While InStr(1, txt, "  ") > 0: txt = Replace(txt, "  ", " "): Wend    'Удаление лишних пробелов

[Sasha_Smirnov]

Это изящно, да. Но в сканированных текстах и три пробела не редкость!

Как говорится, добавлено через 7 минут.

Хорошо! Я всё понял. Интерпретатор бэйсик всё ж не в башке!

[Old_Man_nsk]

Спасибо большое, еще не разбирал, но опыта, вижу у меня маловато, думаю сегодня разобраться, вообще то хотел переделать: исходные данные на корректуру вбиты в "тело", взялся заготовить таблицу из двух столбцов в Excel (у меня все макросы в ем, довольно громоздкий оперативный учет в редакции), бросить жалко и переписать хотя бы в акцесс - вроде работет неплохо
исходная табл для оператора
1. исх.симв. конеч.симв
2. исх.симв. конеч.симв
3. исх.симв. конеч.симв и т.д. пары до разумного предела (300 -400)

эту таблицу должен сопровождать оператор, нажал кнопку и порядок
Сейчас прога (в теле исходные) вроде работает, но неустойчиво, да и без конца появляются новые варианты корректуры, кое какие замены не делает... думаю, когда это все в массив загнать, то потребуется все таки функция, для обработки каждой сравниваемой пары...

для пояснения еще фрагмент
...WordStart = ", В/О"
WordFinish = ", в/о"
Data(I) = Repl(Data(I), WordStart, WordFinish)

WordStart = ", в/О"
WordFinish = ", в/о"
Data(I) = Repl(Data(I), WordStart, WordFinish)

WordStart = ". в/о"
WordFinish = ". В/о"
Data(I) = Repl(Data(I), WordStart, WordFinish)

WordStart = ". В/О"
WordFinish = ". В/о"
Data(I) = Repl(Data(I), WordStart, WordFinish)

WordStart = ". в/О"
WordFinish = ". В/о"
Data(I) = Repl(Data(I), WordStart, WordFinish)


верх в таблице

'Время
WordStart = "с 1-00"
WordFinish = "с 1:00"
Data(I) = Repl(Data(I), WordStart, WordFinish)

WordStart = "с 2-00"
WordFinish = "с 2:00"
Data(I) = Repl(Data(I), WordStart, WordFinish)

WordStart = "с 3-00"
WordFinish = "с 3:00"
Data(I) = Repl(Data(I), WordStart, WordFinish)

WordStart = "с 4-00"
WordFinish = "с 4:00"
Data(I) = Repl(Data(I), WordStart, WordFinish)

WordStart = "с 5-00"
WordFinish = "с 5:00"
Data(I) = Repl(Data(I), WordStart, WordFinish)

WordStart = "с 6-00"
WordFinish = "с 6:00"
Data(I) = Repl(Data(I), WordStart, WordFinish)

WordStart = "с 7-00"
WordFinish = "с 7:00"
Data(I) = Repl(Data(I), WordStart, WordFinish)

WordStart = "с 8-00"
WordFinish = "с 8:00"
Data(I) = Repl(Data(I), WordStart, WordFinish)

WordStart = "с 9-00"
WordFinish = "с 9:00"
Data(I) = Repl(Data(I), WordStart, WordFinish)

WordStart = "с 10-00"
WordFinish = "с 10:00"
Data(I) = Repl(Data(I), WordStart, WordFinish)...

фрагмент исходного текста

-- Общепит --
Официант
Опыт работы от 1 года. Приятная внешность. З/п от 7000 руб. Тел.299-36-94, 299-36-91 e-mail:salar2006@yandex.ru,КА «Салар»
Повар
Ресторан.Возраст до 40 лет Опыт работы от 3 лет.Оплата высокая. Тел.299 -36-94, 299- 36-91 e-mail:salar2006@yandex.ru, КА «Салар»
Технолог пищевого производства
Мясо, рыба. Работа в Коченёво. З/п 15000 руб. Тел.299-36-94, 299-36-91 e-mail:salar2006@yandex.ru, КА «Салар»

-- Офисные работники --
Методист В компанию по автоматизации бизнес-процессов, продаже программного обеспечения требуется м/ж, возраст от 23 лет, в/о. Широкий спектр знаний в области информационных технологий и общих принципов учета. Опыт работы с технической документацией (составление, анализ). Опыт работы с пользователями. Компания предлагает: официальное трудоустройство, полный социальный пакет, достойную оплату труда. Готовность к командировкам (вахтам). Готовность к большим объемам работ. Умение работать в команде, неконфликтность. Тел.344-46-66, 344-45-88, 344-43-00, e-mail: ka-forum@ngs.ru, сайт:www.forum.jobnsk.ru, ул.Петропавловская, 17. КА"ФОРУМ"
ОФИС-МЕНЕДЖЕР (С ФУНКЦИЯМИ КАССИРА) В крупную стабильную компанию, занимающуюся продажами и монтажом пластиковых окон. Женщина, возраст 20-35 лет, образование не ниже среднеспециального (бухгалтер, кассир), желателен опыт работы офис-менеджером, кассиром. Функции: оформление документов при заключении договора, ведение внутренней документации, работа с ККМ. Пользователь ПК (Excel, Word), внимательность, усидчивость, доброжелательность. З/п 6000-16000 руб. Офис находится на пл. Калинина. Контактное лицо: Горбачева Виктория. Тел.29-15-603, 29-07-720, 21-88-619, e-mail: StroyPersona@ngs.ru www.StroyPersona.com КА "СтройПерсона"

-- Охрана --
Охранники лицензированные
Работа вахтовым методом. Сургут, Белово. З/п от 15000 руб. Проезд за счет фирмы. тел.299-36-94, 299-36-91 e-mail:salar2006@yandex.ru, КА «Салар»
Охранники лицензированные и без лицензии
Возраст 21-50 лет. По городу. С последующим лицензированием. З/п от 8500 руб. Тел.299-36-94, 299-36-91 e-mail:salar2006@yandex.ru, КА «Салар»
Сотрудник службы безопасности
Мужчина, возраст 30-40 лет, в\о. Опыт работы в милиции не менее 6 лет. Функции: контроль за сотрудниками, проверка сотрудников, сопровождение груза, слежение

[EducatedFool]

когда это все в массив загнать, то потребуется все таки функция, для обработки каждой сравниваемой пары...

Для этого в VBA есть встроенная функция Replace

Кроме того, я предложил замену для вашей функции Repl - функцию ReplaceAll:

Function ReplaceAll(ByVal Stroka As String, ByVal WordStart As String, ByVal WordFinish As String) As String
    While InStr(1, Stroka, WordStart) > 0
        Stroka = Replace(Stroka, WordStart, WordFinish)
    Wend
    ReplaceAll = Stroka
End Function

Сейчас прога (в теле исходные) вроде работает, но неустойчиво, да и без конца появляются новые варианты корректуры, кое какие замены не делает...

В вашем коде много лишних строк.
Я, конечно, могу переделать код так, чтобы обеспечивалась необходимая функциональность, и при этом не терялась гибкость (чтобы макрос легко можно было подправить при изменении правил корректуры), но если Вы и впредь будете скидывать по кусочку кода, мне это очень скоро надоест.

Сразу бы прикрепили весь код - уже получили бы готовый макрос.
(код у вас большой, так что прикрепляйте его в виде текстового файла)

В моём макросе код

WordStart = ", В/О"
WordFinish = ", в/о"
Data(I) = Repl(Data(I), WordStart, WordFinish)

WordStart = ", в/О"
WordFinish = ", в/о"
Data(I) = Repl(Data(I), WordStart, WordFinish)

WordStart = ". в/о"
WordFinish = ". В/о"
Data(I) = Repl(Data(I), WordStart, WordFinish)

WordStart = ". В/О"
WordFinish = ". В/о"
Data(I) = Repl(Data(I), WordStart, WordFinish)

WordStart = ". в/О"
WordFinish = ". В/о"
Data(I) = Repl(Data(I), WordStart, WordFinish)

заменён на

txt = Replace(txt, ", В/О", ", в/о")
    txt = Replace(txt, ". В/О", ". В/о")

Аналогично вот этот код:

...WordStart = "с 9-00"
WordFinish = "с 9:00"
Data(I) = Repl(Data(I), WordStart, WordFinish)

WordStart = "с 10-00"
WordFinish = "с 10:00"
Data(I) = Repl(Data(I), WordStart, WordFinish)...

гораздо проще смотрится в виде одной строки txt = Replace(txt, "-00", ":00")

Вот весь макрос:

Sub Корректировка()
    Filename = "C:\Documents and Settings\John\Рабочий стол\Чистка\Техт.txt"

    Set ts = CreateObject("scripting.filesystemobject").OpenTextFile(Filename, 1, False)
    txt = ts.Readall: ts.Close    ' считываем файл в переменную txt

    While InStr(1, txt, "  ") > 0: txt = Replace(txt, "  ", " "): Wend    'Удаление лишних пробелов

    СимволыБезПробелов = "+-*/$#&="
    For I = 1 To Len(СимволыБезПробелов)    'Убираем Пробелы, окружающие СимволыБезПробелов
        Символ = Mid$(СимволыБезПробелов, I, 1)
        txt = Replace(txt, " " & Символ, Символ)
        txt = Replace(txt, Символ & " ", Символ)
    Next I

    txt = Replace(txt, " " & vbNewLine, vbNewLine)    'Удаление пробелов в начале каждой строки
    txt = Replace(txt, vbNewLine & " ", vbNewLine)    'Удаление пробелов в конце каждой строки
    
    txt = Replace(txt, ", В/О", ", в/о")
    txt = Replace(txt, ". В/О", ". В/о")
    
    txt = Replace(txt, "-00", ":00")

    MsgBox txt    ' отображение текста файла
End Sub

[EducatedFool]

взялся заготовить таблицу из двух столбцов в Excel (у меня все макросы в ем, довольно громоздкий оперативный учет в редакции), бросить жалко и переписать хотя бы в акцесс - вроде работет неплохо
исходная табл для оператора
1. исх.симв. конеч.симв
2. исх.симв. конеч.симв
3. исх.симв. конеч.симв
и т.д. пары до разумного предела (300 -400)

Access тут не нужен - предложенный Вами вариант с таблицей в Excel наиболее оптимален для решения подобной задачи.

Предложенный мной в предыдущем посте вариант с txt = Replace(txt, "-00", ":00") будет некорректно работать с номерами телефонов, но, тем не менее, это ещё не повод использовать конструкцию вроде этой:

...WordStart = "с 9-00"
WordFinish = "с 9:00"
Data(I) = Repl(Data(I), WordStart, WordFinish)

WordStart = "с 10-00"
WordFinish = "с 10:00"
Data(I) = Repl(Data(I), WordStart, WordFinish)...

В таблице Excel можно сделать не 2 столбца, а 4:
исх.симв., конеч.симв, исх.маска, конеч.маска
По первым 2-м столбцам будут происходить замены вроде
", В/О" -> ", в/о"

а при помощи масок (в 3-м и 4-м столбцах) - замены типа
"с 9-00" -> "с 9:00"
с использованием маски "с ##-##" -> "с ##:##"

Прикрепите к сообщению файл excel с исходным кодом макроса.
Посмотрим, как это можно оптимизировать.

[Old_Man_nsk]

Сообщение от EducatedFool

Access тут не нужен - предложенный Вами вариант с таблицей в Excel наиболее оптимален для решения подобной задачи.

Предложенный мной в предыдущем посте вариант с txt = Replace(txt, "-00", ":00") будет некорректно работать с номерами телефонов, но, тем не менее, это ещё не повод использовать конструкцию вроде этой:

...WordStart = "с 9-00"
WordFinish = "с 9:00"
Data(I) = Repl(Data(I), WordStart, WordFinish)

WordStart = "с 10-00"
WordFinish = "с 10:00"
Data(I) = Repl(Data(I), WordStart, WordFinish)...

В таблице Excel можно сделать не 2 столбца, а 4:
исх.симв., конеч.симв, исх.маска, конеч.маска
По первым 2-м столбцам будут происходить замены вроде
", В/О" -> ", в/о"

а при помощи масок (в 3-м и 4-м столбцах) - замены типа
"с 9-00" -> "с 9:00"
с использованием маски "с ##-##" -> "с ##:##"

Прикрепите к сообщению файл excel с исходным кодом макроса.
Посмотрим, как это можно оптимизировать.

Послал на асю, не подумав... а теперь ссылка из буфера потерялась. Не то нажал! http://bola93.o3000.ru

[Old_Man_nsk]

повисла моя оптимизация, однако...