Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Замена в фрагментах текста с перебором заменяемых слов
 
#1
03.02.2022 23:45:41
Добрый, попалась гадкая таблица для анализа и сравнения, но проглядывалась некая система, между цифрами в конце пробел, а должен быть символ. Ну я как програмист мягко говоря не очень, но думаю по идее замены макрорекодер пишет, попробую. На удивление сработало. Х и У тут отдельно, т.к. мне кажется что только Х отработает 0&" "&0 ,1&" "&1, 2&" "&2 ,3&" "&3     ...      9&" "&9  или я ошибаюсь?[
т.е. было г. Азов Васильева 79 1 стало г. Азов Васильева 79что нибудь1
              г. Азов, Васильева, д. 79 1 стало  г. Азов, Васильева, д. 79что нибудь1

Код
Sub замена()
Dim x, y As Integer
   
For x = 0 To 9 '
For y = 0 To 9
  Selection.Replace What:=x & " " & y, Replacement:=x &"что нибудь"& y, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
Next

Next
End Sub
Но вопрос на самом деле не в этом(просто плодить темы на схожую тему не правильно)
Вот с буквами сложнее, объявил массив и если пишу Selection.Replace x & "что нибудь" & АБВ, x & АБВ, где АБВ-имя переменной, то ошибка, попытался втулить for each, вообще закидало ошибками.

по запарке оставил i и вроде бы отрабатывает, но мне не ясно почему?  Я ведь i не объявлял, что оно значит? или это нечто по умолчанию?
т.е. было г. Азов Васильева 79 Б стало г. Азов Васильева 79Б
               г. Азов , Васильева,, 79 Б стало г. Азов ,Васильева,, 79Б
Код
Sub замена2()Dim x As VariantDim АБВ As Variant
АБВ = Array("а", "б", "в", "г", "д", "е", "ё", "ж", "з", "и", "й", "к", "л", "м", "н", "о", "п", "р", "с", "т", "у", "ф", "х", "ц", "ч", "ш", "щ", "ъ", "ы", "ь", "э", "ю", "я")
For x = 0 To 9 '
Selection.Replace x & " " & i, x & i   
Next
End Sub
 
 
 
#2
04.02.2022 08:40:45
mihail_ms, Доброе утро!
Вы бы приложили пример, чтобы понимать о чем Вы. Желательно, чтобы он соответствовал правилам форума п. 2.3-2.4
  2.3. Приложите файл(ы) с примером (общим весом не более 300Кб) в реальной структуре и форматах данных того, что есть сейчас и того, что хотелось бы на выходе.
  2.4. Не прикладывайте файлы-примеры с персональными данными, конфиденциальной информацией, коммерческой или государственной тайной! Яндекс и Google не спят - проиндексируют ваши данные и привет - они попадут в открытый доступ. И даже удаление темы потом не поможет.
Изменено: Msi2102 - 04.02.2022 08:41:29
 
 
 
#3
04.02.2022 08:52:25
Код на листе 1, в комментарии кода, моя попытка с ошибкой, вероятно я не догоняю, но почему оно работает?.  
 
 
 
#4
04.02.2022 09:15:13
Файл не смотрел, но правильнее так:
Код
Sub замена2()
Dim x
Dim АБВ As Variant
АБВ = Array("а", "б", "в", "г", "д", "е", "ё", "ж", "з", "и", "й", "к", "л", "м", "н", "о", "п", "р", "с", "т", "у", "ф", "х", "ц", "ч", "ш", "щ", "ъ", "ы", "ь", "э", "ю", "я")
For x = 0 To Ubound(АБВ)
'АБВ(x) - это обращение к элементу массива АБВ
Selection.Replace АБВ(x) & " ", АБВ(x)
'Selection.Replace АБВ(x) & " " & i, АБВ(x) & i
Next
End Sub

но что такое i я не знаю и что в ней должно быть тоже. Она нигде не объявлена и ей не назначается никакое значение. Поэтому закомментировал вариант с ней. Так же можно и чуть иначе сделать(i не используем):
Код
Sub замена2()
Dim x
Dim АБВ As Variant
АБВ = Array("а", "б", "в", "г", "д", "е", "ё", "ж", "з", "и", "й", "к", "л", "м", "н", "о", "п", "р", "с", "т", "у", "ф", "х", "ц", "ч", "ш", "щ", "ъ", "ы", "ь", "э", "ю", "я")
For each x in АБВ 'цикл по каждому элементу массива
'x - это обращение к элементу массива АБВ, но уже циклом For Each
Selection.Replace x & " ", x
Next
End Sub

Ну и правильнее указывать параметры Replace, т.к. они наследуются от ручной замены на листе и в коде могут отработать не так, как ожидалось.
Код
Selection.Replace x & " ", x, xlPart, MatchCase:=False, searchformat:=False
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#5
04.02.2022 09:18:49
mihail_ms, здравствуйте

По коду №1: нужно ЗАМЕНИТЬ пробелы между числами на произвольный текст
По коду №2: нужно УДАЛИТЬ пробелы, идущие после цифр и перед строчными буквами (не наоборот)
Не учтён обратный порядок (после букв и перед цифрами) а также регистр букв. Надо или нет - ХЗ

И то, и то обычно решается регулярками. Прокомментируйте мои обобщения. Если никто не подскажет, потом покажу…

Цитата
Дмитрий(The_Prist) Щербаков: правильнее указывать параметры Replace
Форматы не наследуются (Сокол недавно подсказал)  ;)
Изменено: Jack Famous - 04.02.2022 09:44:44
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#6
04.02.2022 09:39:54
mihail_ms
хотите помощи?
обьясните что за задачу вы решаете, может кто-то сможет помочь
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#7
04.02.2022 10:24:45
Если правильно понял, то можно попробовать или макросом или UDF:

Код
Sub ReplRegExp1()
    Dim n As Range
    Set RE1 = CreateObject("VBScript.RegExp"): RE1.Global = True: RE1.IgnoreCase = True
    Set RE2 = CreateObject("VBScript.RegExp"): RE2.Global = True: RE2.IgnoreCase = True
    RE1.Pattern = "(\d)( *(?:\s)+ *)(?=\d)"
    RE2.Pattern = "(\d)( *(?:\s)+ *)(?=[A-Za-zА-Яа-яЁё])"
    For Each n In Selection
        n = RE1.Replace(n, "$1-")
        n = RE2.Replace(n, "$1")
    Next n
End Sub

Public Function ReplRegExp(ByRef n As Range)
On Error GoTo ErrHand
    Set RE1 = CreateObject("VBScript.RegExp"): RE1.Global = True: RE1.IgnoreCase = True
    Set RE2 = CreateObject("VBScript.RegExp"): RE2.Global = True: RE2.IgnoreCase = True
    RE1.Pattern = "(\d)( *(?:\s)+ *)(?=\d)"
    RE2.Pattern = "(\d)( *(?:\s)+ *)(?=[A-Za-zА-Яа-яЁё])"
    m = n.Value
    m = RE1.Replace(m, "$1-")
    m = RE2.Replace(m, "$1")
    ReplRegExp = m
Exit Function

ErrHand:
ReplRegExp = "Ошибка"
End Function


PS использовал изыскания Jack Famous, отсюда
 
 
 
#8
04.02.2022 10:33:14
Цитата
Jack Famous написал:
Форматы  не наследуются
не согласен. Они наследуются, но не сбрасываются даже указанием SearchFormat:=False. Попробуй сделать следующее:
в диапазоне А1:А10 запиши во всех ячейках букву "а". Одну из них залей красной заливкой.
Запусти вручную поиск без формата - Найти все. Найдет все. Задай формат - красная заливка. Найдет одну, залитую цветом.
Теперь, не сбрасывая формат запусти код поиска
Код
Set rc = Range("A1:A10").Find("а", , xlFormulas, xlPart)
MsgBox rc.Address

посмотри, какую ячейку найдет. Только ту, которая залита цветом. Теперь пробуем сбросить поиск по формату в коде:
Код
Set rc = Range("A1:A10").Find("а", , xlFormulas, xlPart, searchformat:=False)
MsgBox rc.Address

Но он не сбрасывается, несмотря на попытку. Вывод - он наследуется, при этом очень-очень сильно :) Настолько, что даже сбросить себя не дает, если не указать явно ВСЕ параметры:
Код
Set rc = Range("A1:A10").Find("а", rc.Cells(1), xlFormulas, xlPart, xlByColumns, xlNext, False, False, searchformat:=False)
MsgBox rc.Address

притом очень важно указать именно все - иначе получим неверный результат.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#9
04.02.2022 12:07:26
Дмитрий(The_Prist) Щербаков, спасибо за тесты! Всё нужно проверять…
Вот тут Владимир мне это сказал со ссылкой на документацию, а оно вон чё

Осталось понять, это только я неправильно понял его и документацию или же она некорректная (для меня это уже так)
А ведь до этого просто все всегда указывал и всем советовал  :D
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#10
04.02.2022 13:47:13
Цитата
написал:
Всё нужно проверять
да. Провел тесты - был неправ.
Проблема была в том, что закрасил ячейку А2, которая естественно, при любом поиске выдавалась первой :)  Но если закрасить А4 - то все будет, как и описано. Т.е. формат не будет учитываться при поиске. Так что отбой - все правильно Владимир описывал ранее, равно как и все написано в справке.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#11
04.02.2022 13:53:59
Цитата
Jack Famous написал:
По коду №1: нужно ЗАМЕНИТЬ пробелы между числами на произвольный текст
В данном случае да, но вообще это может быть любой символ или их сочетание, например Х&" к "&У заменить на Х&" - "&У , где х и у любые указанные значения, цифры, или определенные символы, или даже знаки....

Цитата
написал:
По коду №2: нужно УДАЛИТЬ пробелы, идущие после цифр и перед строчными буквами (не наоборот)Не учтён обратный порядок (после букв и перед цифрами) а также регистр букв. Надо или нет - ХЗ
Ну опять таки, в этом случае были пробелы, но хотелось инструмент, который нужное(знак, букву, пробел) поменяет на нужное(знак,букву, пробел), для того и 2 переменные, одна с цифрами, другая с буквами. Регистр и прочее я так понимаю решается в моем случае не обязательными параметрами MatchCase:=False

Эксэль ВЕЛИКАЯ вещь, ии способов решения не один и даже не 2. Про  Регулярки слышал. Не люблю функции и доп столбцы, люблю кнопки)))
Цитата
Дмитрий(The_Prist) Щербаков
Ваш код увы отрабатывает не верно, убивает все пробелы, но оно и по коду мне не видно,  Selection.Replace x & " ", x  где указана АБВ, и как ее задействовать, на удивление код с i убивает только пробелы между цифрой и буквой, а между цифрой/цифрой или буквой/буквой не трогает...
Изменено: mihail_ms - 04.02.2022 14:12:58
 
 
 
#12
04.02.2022 14:05:27
Эту задачу например можно было бы решить и через таблицу соответствий, создаешь табличку 1 а/1а   2 а/2а ... и т.д. табличку делать минуты 3 с учетом прогрессии и объеденения/сцепки, а далее макросом , это конечно элегантно, но с доп таблицей...
Код
Set x = Intersect(Sheets("лист откуда").[A2:A15], Sheets("лист откуда").UsedRange)
For i = 1 To x.Rows.Count
Intersect(Sheets("лист где меняем").[d2:d99999], Sheets("лист где меняем").UsedRange).Replace x(i, 1), x(i, 2)
 
 
 
#13
04.02.2022 14:19:21
Цитата
mihail_ms написал:
Ваш код увы отрабатывает не верно
Мой код отрабатывает верно. Другой вопрос - что Вы ожидали от работы кода? В массиве у Вас ни одной цифры нет, а в примере пробелы только после цифр надо убирать? Или что? Я просто показал как правильно произвести цикл по заданному массиву.
Цитата
mihail_ms написал:
на удивление код с i убивает только пробелы между цифрой и буквой
почему оно работает?
потому что у Вас идет цикл с обработкой исключительно ЦИФР от 0 до 9:
Код
For x = 0 To 9
следовательно, при изначальных исходных данных в файле у Вас убирается пробел после номеров домов и все. А буквы никак не затрагиваются. При этом i там совершенно не нужна - можете её убрать и убедиться, что и без неё все будет работать совершенно так же.

Вы бы задачу описали как-то более конкретно какую решить хотите - глядишь и решение какое-то нарисуется. А пока никто не понимает что надо и что именно не так, особенно если учесть тот факт, что в примере и в сообщении #1 исходный текст представлен по разному.
Изменено: Дмитрий(The_Prist) Щербаков - 04.02.2022 14:23:02
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#14
04.02.2022 15:25:48
Дмитрий(The_Prist) Щербаков , ну уточнение я давал в 11 сообщении. Про i понял, оно ни на что не влияет....

По Вашему коду до меня дошло, что Х = это переменная масива букв, т.е. можно обьявить еще оду переменную с цифрами и комбинировать их. А тот же массив может содержать не только "А", но и например выражение "АА", правильно? Спасибо, буду пробывать, извените за косноязычие , если что. Считайте, что я гуманитарий )))
А я то думал, что Х это цифры от 0 до 9... как было в моем первом макросе.
 
 
 
#15
04.02.2022 16:03:51
Цитата
mihail_ms написал:
Про   Регулярки  слышал.
В сообщении#7
 
 
 
#16
18.02.2022 11:56:34
Регулярные выражения не осилил, мозг закипел, в сообщении 7 работает, но хотел добавить еще критерий, что бы изменения происходили только после последней запятой. Вопрос еще открыт. Надеюсь по свободе разберусь.

Пока Родил монстра
Код
For Each element In Selection
sText = element.Value
    n = InStrRev(sText, ",") ' ищем положение зпт с конца(номер символа в строке)
    n = n + 1' зачем то добавляем 1 )))  без этого не работает
      
АБВ = Array("а", "б", "в", "г", "д", "е", "ё", "ж", "з", "и", "й", "к", "л", "м", "н", "о", "п", "р", "с", "т", "у", "ф", "х", "ц", "ч", "ш", "щ", "ъ", "ы", "ь", "э", "ю", "я")
 
For i = 0 To UBound(АБВ )
For x = 0 To 9
 
sTextREP = Replace(element.Value, x & " " & АБВ (i), x & АБВ (i), [n])'ищем\заменяем где n это начало откуда ищем 
  
element.Value = Left$(sText, n - 1) & sTextREP'и каждый раз записываем изменения
 
Next x
Next i
        
    Next 'и так по кругу

Но он конечно тормоз еще тот.  
Изменено: mihail_ms - 18.02.2022 11:59:22
 
 
 
#17
18.02.2022 14:25:36
Ну, ну если нужно после последней запятой, то попробуйте так:
Код
Sub ReplRegExp1()
    Dim n As Range
    Dim m As Integer
    Set RE1 = CreateObject("VBScript.RegExp"): RE1.Global = True: RE1.IgnoreCase = True
    Set RE2 = CreateObject("VBScript.RegExp"): RE2.Global = True: RE2.IgnoreCase = True
    RE1.Pattern = "(\d)( *(?:\s)+ *)(?=\d)"
    RE2.Pattern = "(\d)( *(?:\s)+ *)(?=[A-Za-zА-Яа-яЁё])"
    For Each n In Selection
        m = InStrRev(n, ",")
        If m > 0 Then
            n = Left(n, m - 1) & RE1.Replace(Mid(n, m), "$1-")
            n = Left(n, m - 1) & RE2.Replace(Mid(n, m), "$1")
        End If
    Next n
End Sub

UDF не переделывал
Изменено: Msi2102 - 18.02.2022 15:06:40
 
 
 
#18
18.02.2022 23:21:01
Msi2102 - , Очень большое спасибо, реально круто.  Если обернут в отключение обновлений отрабатывает не зависимо от кол-ва RE.Pattern-ов, к слову я штук 5 добавил и не хочу на этом останавливаться)
Если кому надо ищите RegEx в Excel: шпаргалка по синтаксису регулярных выражений и в RE.Pattern ставим нужное
 
 
 
#19
19.02.2022 11:53:06
Цитата
mihail_ms написал:
RegEx в Excel: шпаргалка по синтаксису регулярных выражений
Если кому надо то ЗДЕСЬ, ЗДЕСЬ, ЗДЕСЬ, а может ещё и ЗДЕСЬ кому-то пригодится, а если поискать, то можно найти ещё кучу интересного
 
 
 
Страницы: 1
Наверх