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

RSS

Замена символов, цифр и букв (кириллица и латиница) на заданный разделитель с последующей очисткой, Попытка объединить несколько тем на общую тематику.

Jack_Famous

Пользователь

Сообщений: 12274 Регистрация: 07.11.2014

OS: Win 10 Корп. x64 | Excel 2016 x64: | Browser: Chrome

13.04.2016 12:35:32

Здравствуйте, уважаемые форумчане, форумчанки, начинающие форумчанята и просто гости сайта! Есть несколько тем, которые меня заинтересовали по поводу удаления/извлечения/замены символов, цифр и текста Replace_symbol, от Nerv, Варианты функции от ikki и вчерашняя тема по извлечению чисел.

Записал макрорекордером вот такой макрос (минусы не трогает, точки заменяет запятыми, а остальные символы заменяет на пробелы в конце подчищает результат)

Код

Sub ReplacerSym()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Selection.Replace What:="<", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Selection.Replace What:=">", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Selection.Replace What:="!", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Selection.Replace What:="@", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Selection.Replace What:="~#", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Selection.Replace What:="$", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Selection.Replace What:="%", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Selection.Replace What:="^", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Selection.Replace What:="&", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Selection.Replace What:="~*", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Selection.Replace What:="~~", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Selection.Replace What:="(", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Selection.Replace What:=")", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
   
    Selection.Replace What:="_", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Selection.Replace What:="+", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Selection.Replace What:="/", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Selection.Replace What:="|", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Selection.Replace What:="\", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Selection.Replace What:=";", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Selection.Replace What:=":", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Selection.Replace What:="=", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Selection.Replace What:="""", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Selection.Replace What:="#", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Selection.Replace What:="¹", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Selection.Replace What:="%", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Selection.Replace What:="~?", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Selection.Replace What:=", ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Selection.Replace What:=" ,", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
            
Selection.Value = Application.Clean(Selection.Value)
Selection.Value = Application.Trim(Selection.Value)


Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Подскажите пожалуйста, как записать этот код в более удобном (коротком) виде, как у ikki или Nerv. И как записать подобные макросы для замены латиницы и кириллицы (отдельно) на пробел (пробел, потому что потом подчистить через Trim можно). Вы спросите: а зачем ВООБЩЕ менять текст или символы на пробелы, почему не удалить? А я отвечу))) потому что иногда исходником является мешанина типа "катя14.48рыба-меч890куры-890,15" и разделить по какому-то ОДНОМУ признаку никак

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

Прикрепленные файлы

Замена символов, букв и цифр.xlsx (9.34 КБ)

Изменено: Jack Famous - 01.12.2022 11:32:46

Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄

Sanja

Модератор

Сообщений: 20892 Регистрация: 10.01.2013

13.04.2016 12:58:28

Цитата
Jack_Famous написал: Поиск в интернете толком ничего не дал

Поищите Использование Регулярных выражений в VBA

Согласие есть продукт при полном непротивлении сторон

Jack_Famous

Пользователь

Сообщений: 12274 Регистрация: 07.11.2014

OS: Win 10 Корп. x64 | Excel 2016 x64: | Browser: Chrome

13.04.2016 13:05:29

Sanja, списибо, но с макросами ~~не знаком~~ знаком не близко)))

Изменено: Jack_Famous - 13.04.2016 13:28:40

Sanja Модератор Сообщений: 20892 Регистрация: 10.01.2013	#4 13.04.2016 13:08:57 Так пора начинать! По первой ссылке есть UDF от kuklp. Поиграйтесь с ней. В St$ занесите свой набор символов и проверьте Согласие есть продукт при полном непротивлении сторон

Jack_Famous

Пользователь

Сообщений: 12274 Регистрация: 07.11.2014

OS: Win 10 Корп. x64 | Excel 2016 x64: | Browser: Chrome

13.04.2016 13:18:36

Sanja, всё верно, хватит в девках сидеть)) подскажите пожалуйста, как эту функцию превратить в макрос для Selection - и я погнал)))

Код
Function Replace_symbols(ByVal txt As String) As String St$ = "~!@#$%^&\|\/.*=\|`'""" For i% = 1 To Len(St$) txt = Replace(txt, Mid(St$, i, 1), "_") Next Replace_symbols = txt End Function

The_Prist

Пользователь

Сообщений: 15878 Регистрация: 15.09.2012

Профессиональная разработка приложений для MS Office

13.04.2016 13:31:02

Цитата
Jack_Famous написал: как эту функцию превратить в макрос для Selection

Для начала почитать про RegExp и узнать оттуда, что в шаблоне могут быть метасимволы, которые надо превращать с обычные для замены, путем проставления перед ними слеша...Плюс хотя бы в общих чертах понять как RegExp применять.

Цитата
Jack_Famous написал: и я погнал)))

Чтобы гнать - надо хотя бы теорию понять. Сейчас Вы гоните в Лондон из Рязани совершенно не зная ни дороги, ни времени на её преодоление...А это чревато последствиями. Не бывает быстрых побед - бывают быстрые поражения.

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...

Апострофф

Пользователь

Сообщений: 807 Регистрация: 06.04.2015

13.04.2016 13:35:45

Код
sub макрос_для_Selection dim r as range St$ = "~!@#$%^&\|\/.*=\|`'""" for each r in selection For i% = 1 To Len(r) r = Replace(r, Mid(St$, i, 1), "_") Next next end sub

Jack_Famous

Пользователь

Сообщений: 12274 Регистрация: 07.11.2014

OS: Win 10 Корп. x64 | Excel 2016 x64: | Browser: Chrome

13.04.2016 14:07:16

The_Prist, к сожалению, пока не могу заняться изучением VBA (но обязательно приду к этому)... Было интересно, (без "подводных камней", которые требуют изучения RegExp) - есть ли способ упростить запись типа "найти и заменить" для большого количества символов, если каждый менять на пробел (к примеру). Можно ведь также сделать и для кириллицы с латиницей - 100 строчек практически одинакового кода для неумеки в VBA ))))
Апострофф. спасибо большое! ))) На его основе сделаю для текста...

Jack_Famous

Пользователь

Сообщений: 12274 Регистрация: 07.11.2014

OS: Win 10 Корп. x64 | Excel 2016 x64: | Browser: Chrome

13.04.2016 14:25:32

Пока так... В принципе, комбинации этих макросов дело делают, и довольно быстро - хватит на первое время

Всем большое спасибо за участие (особенно Апострофф за предоставленный поправленный макрос)! Жду замечаний и предложений...

Код

Sub ReplacerSym()


Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual


Dim r As Range

St$ = "~<>?+!@#$:;%^&|\/*(){}[]=|`'"""
For Each r In Selection
    For i% = 1 To Len(r)
        r = Replace(r, Mid(St$, i, 1), " ")
    Next
Next

Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        


Selection.Value = Application.Clean(Selection.Value)
Selection.Value = Application.Trim(Selection.Value)

Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True


End Sub
______________________________________________________________________________

Sub ReplacerKirill()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual


Dim r As Range

St$ = "АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯабвгдеёжзийклмнопрстуфхцчшщъыьэюя"
For Each r In Selection
    For i% = 1 To Len(r)
        r = Replace(r, Mid(St$, i, 1), " ")
    Next
Next

'Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
'        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
'        ReplaceFormat:=False
        


Selection.Value = Application.Clean(Selection.Value)
Selection.Value = Application.Trim(Selection.Value)

Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True


End Sub
_____________________________________________________________________________

Sub ReplacerLatin()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual


Dim r As Range

St$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
For Each r In Selection
    For i% = 1 To Len(r)
        r = Replace(r, Mid(St$, i, 1), " ")
    Next
Next

'Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
'        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
'        ReplaceFormat:=False
        


Selection.Value = Application.Clean(Selection.Value)
Selection.Value = Application.Trim(Selection.Value)

Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True


End Sub

The_Prist

Пользователь

Сообщений: 15878 Регистрация: 15.09.2012

Профессиональная разработка приложений для MS Office

#10

13.04.2016 14:28:09

Код
Selection.Value = Application.Clean(Selection.Value) Selection.Value = Application.Trim(Selection.Value)

у таких выражений есть тенденция к укорачиванию строк в ячейках до 255 символов, плюс выдаст ошибку, если будет выделено более 65536 строк данных...Поэтому я бы вынес это в цикл, раз он все равно есть:

Код

St$ = "~<>?+!@#$:;%^&|\/*(){}[]=|`'"""
For Each r In Selection
    For i% = 1 To Len(r)
        r = Replace(r, Mid(St$, i, 1), " ")
    Next
    r.Value = Application.Clean(r.Value)
    r.Value = Application.Trim(r.Value)
Next

Собственно, сам цикл можно делать на массиве(хотя есть свои подводные камни).

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...

Jack_Famous

Пользователь

Сообщений: 12274 Регистрация: 07.11.2014

OS: Win 10 Корп. x64 | Excel 2016 x64: | Browser: Chrome

#11

13.04.2016 14:43:51

The_Prist, спасибо за замечание и дополнение!

Давно хотел узнать: в сети популярно вложение Trim в Clean и наоборот и, кажется, без Application. Так вот в этом случае почему-то ощутимо тормозить начинает... А когда вот так просто последовательно вызывать - летает... Почему так?

The_Prist

Пользователь

Сообщений: 15878 Регистрация: 15.09.2012

Профессиональная разработка приложений для MS Office

#12

13.04.2016 14:49:03

Потому что есть разница между Application.Trim и Trim. Trim - это функция VBA, которая удаляет все пробелы спереди и сзади текста. Application.Trim - это вызов функции листа СЖПРОБЕЛЫ, которая удаляет все пробелы спереди и сзади текста, а также все другие пробелы внутри строки, кроме одиночных между словами.
Clean - не существует в VBA, только как WorksheetFunction. Это не что иное, как функция листа ПЕЧСИМВ.
Ну и вложенность функций одна в другую всегда медленнее, чем последовательный их вызов. На больших массивах это более заметно.

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...

Jack_Famous Пользователь Сообщений: 12274 Регистрация: 07.11.2014 OS: Win 10 Корп. x64 \| Excel 2016 x64: \| Browser: Chrome	#13 13.04.2016 14:56:43 The_Prist, спасибо большое за пояснения! ))) почему тогда она чаще выскакивает при поиске...(вопрос не требующий ответа ) 2016-04-14. 10:55. Итоги тестирования: 1. Время работы в "умных" таблицах минимум в 5!!! раз дольше... Так что лучше перед обработкой преобразовать в диапазон. 2. Selection.Value = Application.Clean(Selection.Value), *Selection.Value = Application.Trim(Selection.Value)* а также их цикличные аналоги от Дмитрия "The_Prist" работают по времени одинаково, более того, практически никак не влияют на общее время работы макроса. 2016-04-18; 17:00. Опытным путём было выявлено, что замена циклов и прочего на банальное *Selection.Replace "что_менять", "на_что_менять"* просто ускоряет макросы по пакетной замене в ДЕСЯТКИ !!! раз (в том числе, в умных таблицах). Удачи Изменено: Jack_Famous - 18.04.2016 17:09:06 Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄

Читают тему