Макрос работает так: Берет значение в столбце Б - слова которые нужно заменить, на слова из столбца С и он меняет все эти слова в тексте в столбце E.
1. сделать чтобы учитывался регистр *(если в B указано заменить "ВаСя!" то только это слово должно быть заменено а не другие ваСи тоже) 2. сделать условие при котором не учитывались слова, если они идентичны (в столбце В и С - одинаковые слова) 3. настроить на работу именно с отдельными словами (если пишу "сони" то должно заменится именно слово "сони" - а не все слова в которых есть сочетание этих букв) 4. нужно максимально ускорить работу макроса (работает с большим объемом данных)
Sanja написал: название темы нарушает Правила форума
каюсь. Администраторы, замените пожалуйста название темы. "Ускорение работы и доработка алгоритма работы - макроса массовой замены"
Цитата
Sanja написал: Опишите в сообщении все условия, которые должны быть соблюдены при замене (про регистр и прочее)
ну это вроде я все описал. Про регистр, должна производится замена четко именно определенного слова со своим регистром и символами (если в B стоит слово АфонасиЙ, то в E должны заменится именно эти слова а не аФонасий, АфонАСИЙ и т.д), и это должно быть отдельно слово, а не просто замена набора символов как сейчас. Ну и самое главное ускорить его. Ну и убрать реагирование на слова которые не нужно менять т.е в столбце B и C указаны одинаковые слова. Я это описал в первом сообщении
такой замысел) Особенность другого алгоритма такая долго объяснять) Короче так должно быть) Нужно получается условие которое будет обходить слова полностью идентичные, что бы он не тратил время на них и не менял их
господа, если автору темы с высокой горы нас...ть на тему зачем Вы паритесь над решением? это нужно Вам или автору темы?
уважаемые авторы, задачу нужно описать (лаконично и четко) только тогда можно рассчитывать на четкий и однозначный ответ. если Вам облом описать задачу, или не хватает мозгов это сделать, будьте готовы к тому, что остальным она вообще не интересна
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
Ігор Гончаренко, если не интересна, то и отвечать оскорбительными ответами никто не просит. И задача расписана попунктно. И если что то не понятно, то для это нормальные люди уточняют
Вы сильно ошибаетесь, ибо описана не задача, а то что у Вас не получается в том методе, которым Вы решаете задачу, о которой ничего не сказали. Возможно все что вы делаете надо делать не в Excel, а в Word, где механизм поиска и замены сильно мощнее.
Ігор Гончаренко — вполне нормальный человек и опытный специалист, если что…
Нормальный и я (но это не точно), поэтому уточняю/разъясняю: 1. Макрос массовой замены взят с сайта Дмитрия Щербакова 2. Работа макроса основана на штатном инструменте Excel — "Заменить" (Ctrl+H) 3. В данном решении никак не учитывается тип проверки регистра, а также поиск и замена по формату, а значит, что для них будут использованы последние настройки данного инструмента 4. Вот вам моё решение (список "найти-заменить" должен находиться на листе "соответствия") для массовой замены, в котором вышеприведённое учтено (см. запись макрорекордера в конце)
Коды
Код
Option Explicit
Option Private Module
'===========================================================================================
Sub ЗаменитьВыделенноеПоСписку()
Dim arr, rng As Range, choose As Byte, ByPart As Boolean, NoCase As Boolean
Const shName$ = "соответствия"
Set rng = Selection
choose = MsgBox("Проверяем ячейку Целиком [ДА] или по её Части [НЕТ]?", vbYesNoCancel + vbQuestion + vbDefaultButton1, "ВЫБОР СРАВНЕНИЯ")
If choose = vbCancel Then Exit Sub
If choose = vbNo Then ByPart = True
choose = MsgBox("Проверяем данные с учётом регистра или нет?", vbYesNoCancel + vbQuestion + vbDefaultButton1, "ВЫБОР СРАВНЕНИЯ")
If choose = vbCancel Then Exit Sub
If choose = vbNo Then NoCase = True
Application.ScreenUpdating = False
With Worksheets(shName)
If Len(.Cells(1, 1)) < 1 Or Len(.Cells(1, 2)) < 1 Then MsgBox "Списки замены (было/стало) должны располагаться в первых 2х столбцах листа «" & shName & ", начиная с 1ой строки!", vbCritical, "ОШИБКА СПИСКОВ ЗАМЕНЫ": GoTo fin
arr = .Range("A1:B" & .Cells(Rows.Count, 1).End(xlUp).Row)
End With
Call ReplaceByList_InRange(rng, arr, ByPart, NoCase)
fin: Application.ScreenUpdating = True
End Sub
'-------------------------------------------------------------------------------------------
Function ReplaceByList_InRange(rng As Range, arr2xFR, Optional ByPart As Boolean, Optional NoCase As Boolean) As Boolean
Dim x, i&
If ByPart Then
For i = 1 To UBound(arr2xFR, 1)
rng.Replace arr2xFR(i, 1), arr2xFR(i, 2), 2, xlByRows, Not (NoCase), False, False
Next i
Else
For i = 1 To UBound(arr2xFR, 1)
rng.Replace arr2xFR(i, 1), arr2xFR(i, 2), 1, xlByRows, Not (NoCase), False, False
Next i
End If
ReplaceByList_InRange = True
End Function
'===========================================================================================
'Selection.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False ' макрорекордер
Цитата
Fsociety_: он учитывает и заменят даже те слова которые не нужно трогать … т.к работа происходит с большим объемом данных это довольно сильно тормозит код
было бы любопытно посмотреть замеры времени при замене одинаковых слов и с проверкой. В случае проверки придётся пересобирать массив сравнений без таких одинаковых пар. Это не сложно и быстро, но нелогично, поэтому лично у меня большие вопросы к "особенностям другого алгоритма"
Цитата
Fsociety_: он работает по символам, а нужно конкретно по словам
слово — есть "символы", окружённые пробелом с 1ой или 2х сторон? Если так, то и прописывайте в поле "найти" "символы + пробелы"
Сейчас у вас комплексная задача, которые у нас решаются в ветке Работа. Вывод: дробите задачу по темам или идите в ветку и ищите исполнителя (задача ерундовая). Я бы рекомендовал пересмотреть алгоритм работы ПОЛНОСТЬЮ, поскольку там точно есть, что сильно поправить…
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Вариант. Т.к. у Вас разделители между словами могут быть какими угодно, есть ограничение: им (разделителем) не может быть пробел, и, по окончании работы макроса, они все приводятся к одному виду
Скрытый текст
Код
Option Explicit
Option Compare Binary
Sub ReplaceWords()
Dim arr(), arrF()
Dim I&, J&, lRow&, iStr
With Worksheets("Лист1")
arr = .Range("B9:C" & .Cells(.Rows.Count, "B").End(xlUp).Row).Value
arrF = .Range("E9:E" & .Cells(.Rows.Count, "E").End(xlUp).Row).Value
End With
With CreateObject("Scripting.Dictionary")
.CompareMode = 0
For I = LBound(arr) To UBound(arr)
If Not CStr(arr(I, 1)) Like CStr(arr(I, 2)) Then
.Add CStr(arr(I, 1)), CStr(arr(I, 2))
End If
Next
For I = LBound(arrF) To UBound(arrF)
arrF(I, 1) = ReplaceDlm(arrF(I, 1))
iStr = Split(arrF(I, 1))
For J = 0 To UBound(iStr)
If .Exists(iStr(J)) Then iStr(J) = .Item(iStr(J))
Next
arrF(I, 1) = Join(iStr, " - ") 'единый разделитель между словами
Next
End With
With Worksheets("Лист1")
lRow = .Cells(.Rows.Count, "F").End(xlUp).Row
lRow = IIf(lRow < 9, 9, lRow)
.Range("F9:F" & lRow).Clear
.Range("F9").Resize(UBound(arrF), 1) = arrF
End With
End Sub
Private Function ReplaceDlm(iText)
Dim arrDlm(), iDlm
arrDlm = Array(",", "-", ";") 'набор возможных разделителей между словами
iText = Replace(iText, " ", "")
For Each iDlm In arrDlm
iText = Replace(iText, iDlm, " ")
Next
ReplaceDlm = iText
End Function
БМВ,К сожалению, мне нужно именно в екселе. По поводу описания, 1 вроде точно описал что нужно сделать. Просто я описал это в форме того как оно сейчас работает и как оно должно. Давайте тогда опишу именно конкретно: 1. сделать чтобы учитывался регистр *(если в B указано заменить "ВаСя!" то только это слово должно быть заменено а не другие ваСи тоже) 2. сделать условие при котором не учитывались слова, если они идентичны (в столбце В и С - одинаковые слова) 3. настроить на работу именно с отдельными словами (если пишу "сони" то должно заменится именно слово "сони" - а не все слова в которых есть сочетание этих букв) 4. нужно максимально ускорить работу макроса (работает с большим объемом данных)
Fsociety_ написал: К сожалению, мне нужно именно в екселе.
Почему? Да я и не писал, что исходные и конечные результаты будут в Word. Просто его можно использовать, как промежуток. И к стати, когда пишете о больших объемах, то указывайте что под этим подразумевали.
Jack Famous написал: было бы любопытно посмотреть замеры времени при замене одинаковых слов и с проверкой. В случае проверки придётся пересобирать массив сравнений без таких одинаковых пар. Это не сложно и быстро, но нелогично, поэтому лично у меня большие вопросы к "особенностям другого алгоритма"
под проверкой, я имел ввиду, как то учесть одинаковые слова, что бы не тратилось на них время. К примеру в самом начале чтобы шла проверка на наличие дублей и загон их в массив и дальше уже запускается сам макрос замены без учета дублей которые занеслись в массив.
Цитата
Jack Famous написал: слово — есть "символы", окружённые пробелом с 1ой или 2х сторон? Если так, то и прописывайте в поле "найти" "символы + пробелы"
спасибо я это прекрасно понимаю, и я так этим и пользовался - но учитывая то что таких "символов" нужно менять очень большое кол-во, то мне не очень удобно искать слова в каких ставить пробел а в каких нет - и так же не всегда это поможет к примеру: если первое слово будет "В" и мне нужно заменить только эту букву в начале предложения - но если я поставлю пробел в конце буквы - то макрос заменит все буквы "В" с пробелом справа - а это будут и окончания слов и т.д И таких примеров много.
Fsociety_: как то учесть одинаковые слова, что бы не тратилось на них время
оптимальный вариант очевиден - не загонять эти слова в список "найти и заменить", но у вас такой "алгоритм"… В остальном время, затраченное на проверку "одинаковости" может быть больше времени замены. Узнать точно помогут только тесты, но я не думаю, что на ваших данных разница будет больше пары-тройки секунд (это с огромным запасом сказал)
Цитата
Fsociety_: если первое слово будет "В" и мне нужно заменить только эту букву в начале предложения - но если я поставлю пробел в конце буквы - то макрос заменит все буквы "В" с пробелом справа - а это будут и окончания слов
если вы перестанете говорить абстрактно. то и решение найдёте. Для вашего примера мой вариант прекрасно работает. Все свои "а что, если" смело "запихивайте" в свой пример - вот тогда будет разговор, а пока просто болтовня ни о чём…
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Sanja, Ваш код сработал немного не по неожиданно) С примером который был в файле он работает, а вот уже другими данными он что то не то делает, он ничего не заменил а только вывел результат без всех пробелов:
Скидываю пример текстов на которых пробовал макрос.
Sanja, да блин сколько можно Делают пример. Даёшь решение, которое работает в примере. Говорят - а что, если другое будет? Ну так попробуй))) или сделай пример с учётом своих "а что если"
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Sanja, вспомнил одну штуку — у меня в макросе "текст по столбцам" тоже возникла необходимость в символе-разделителе. Типа, инструмент работает с 1 символом (да - может с несколькими, но там свои нюансы), а у меня разделитель могут состоять из нескольких. Я сделал так: меняю неразрывные пробелы на обычные. Потом меняю свой разделитель (из текста, может состоять из нескольких символов) на неразрывный пробел и запускаю инструмент уже с единичным известным разделителем
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
решение то работает, но не совсем так как надо было, изначальные данные содержать знаки разделители но их не так много, в основном там пробелы, и с ними нужно работать.
Sanja, тот же самый пример, только в вашем коде нужно что бы учитывались пробелы, и все. Ваш пример вроде отлично подходит только нужно что бы он с пробелами работал. Файл приложил
Sanja, Спасибо большое за уделенное время, я просто вопрос задал. Я уже сам в первом Вашем коде поправил. Еще раз большое спасибо, вы помогли решить проблему и + с Вашим кодом появилась доп.функция для редактирования текста о которой я не подразумевал. Спасибо!