Доброго дня всем. Как с помощью макроса удалить текст в каждой ячейки второго столбца во всей таблице, после текста (^34^32<[а-яё]@['а-яё]@>) и до конца текста, в каждой ячейке. Пример: ВОРОНИНЫ" сериал Маша взрослеет–у неё появляются новые интересы, которые пугают родителей, особенно папу! Костя и Вера перед выбором: спрятать свою девочку за семью замками или предоставить ей свободу? Надо оставить: ВОРОНИНЫ" сериал
Доброго дня всем. Как с помощью макроса удалить текст в каждой ячейки второго столбца во всей таблице, после текста (^34^32<[а-яё]@['а-яё]@>) и до конца текста, в каждой ячейке. Пример: ВОРОНИНЫ" сериал Маша взрослеет–у неё появляются новые интересы, которые пугают родителей, особенно папу! Костя и Вера перед выбором: спрятать свою девочку за семью замками или предоставить ей свободу? Надо оставить: ВОРОНИНЫ" сериалlapin9126
И что это за кабалистика? Если шаблон регулярного выражения, то какой-то странный диалект... А можно как-то нормальными человеческими словами произнести?
И что это за кабалистика? Если шаблон регулярного выражения, то какой-то странный диалект... А можно как-то нормальными человеческими словами произнести?Gustav
Ну, например, так. Точнее, именно "на пример" - про конкретно "сериал" :) [vba]
Код
Sub clearEndOfCell() Dim arr Dim tbl As Table Dim i As Integer
Set tbl = ThisDocument.Tables(1)
For i = 1 To tbl.Rows.Count arr = Split(tbl.Cell(i, 2).Range.Text, """ сериал ") If UBound(arr) > 0 Then tbl.Cell(i, 2).Range.Text = arr(0) & """ сериал" End If Next i End Sub
[/vba]
Ну, например, так. Точнее, именно "на пример" - про конкретно "сериал" :) [vba]
Код
Sub clearEndOfCell() Dim arr Dim tbl As Table Dim i As Integer
Set tbl = ThisDocument.Tables(1)
For i = 1 To tbl.Rows.Count arr = Split(tbl.Cell(i, 2).Range.Text, """ сериал ") If UBound(arr) > 0 Then tbl.Cell(i, 2).Range.Text = arr(0) & """ сериал" End If Next i End Sub
Квалификатор ThisDocument предполагает погружение макроса в документ с обрабатываемой таблицей, а не в шаблон Normal.dot. Если же хотите работать из Normal.dot, то замените ThisDocument на ActiveDocument.
Квалификатор ThisDocument предполагает погружение макроса в документ с обрабатываемой таблицей, а не в шаблон Normal.dot. Если же хотите работать из Normal.dot, то замените ThisDocument на ActiveDocument.Gustav
А вот и версия с исходной регуляркой подоспела: [vba]
Код
Sub clearEndOfCell_2() Dim arr Dim tbl As Table Dim i As Integer Dim fnd As Find Dim sep As String
Set tbl = ActiveDocument.Tables(1)
For i = 1 To tbl.Rows.Count Set fnd = tbl.Cell(i, 2).Range.Find
With fnd .Text = "^34^32<[а-яё]@['а-яё]@>" .Replacement.Text = "" .MatchWildcards = True End With
fnd.Execute If fnd.Found Then sep = fnd.Parent.Text arr = Split(tbl.Cell(i, 2).Range.Text, sep) tbl.Cell(i, 2).Range.Text = Trim(arr(0) & sep) End If Next i End Sub
[/vba]
А вот и версия с исходной регуляркой подоспела: [vba]
Код
Sub clearEndOfCell_2() Dim arr Dim tbl As Table Dim i As Integer Dim fnd As Find Dim sep As String
Set tbl = ActiveDocument.Tables(1)
For i = 1 To tbl.Rows.Count Set fnd = tbl.Cell(i, 2).Range.Find
With fnd .Text = "^34^32<[а-яё]@['а-яё]@>" .Replacement.Text = "" .MatchWildcards = True End With
fnd.Execute If fnd.Found Then sep = fnd.Parent.Text arr = Split(tbl.Cell(i, 2).Range.Text, sep) tbl.Cell(i, 2).Range.Text = Trim(arr(0) & sep) End If Next i End Sub
Gustav, Спасибо за помощь, которую вы оказываете таким нубом в VBA как я, но как говориться: «На всякого мудреца довольно простоты». Попробовал ваш последний скрипт и вот что: [moder]Не нужно цитировать целые посты - это нарушение Правил форума. Удалила[/moder]
Gustav, Спасибо за помощь, которую вы оказываете таким нубом в VBA как я, но как говориться: «На всякого мудреца довольно простоты». Попробовал ваш последний скрипт и вот что: [moder]Не нужно цитировать целые посты - это нарушение Правил форума. Удалила[/moder]lapin9126
Что пишет? "Can't find project or library"? Если да, то покажите картинку "галок" в меню Tools-References. Есть ли там какие-нибудь галки "MISSING"?
Что пишет? "Can't find project or library"? Если да, то покажите картинку "галок" в меню Tools-References. Есть ли там какие-нибудь галки "MISSING"?Gustav
Ну, не знаю... У меня всё катит. Начинаю фантазировать "мозговым штурмом": 1. Уберите этот Trim нафиг, т.е. напишите просто: tbl.Cell(i, 2).Range.Text = arr(0) & sep 2. ИЛИ проверьте Normal.dot: по меню Debug \ Compile Normal - будут ли ошибки? 3. ИЛИ переименуйте процедуру - сделайте с циферкой _3 на конце вместо _2 и поместите ее в модуль обрабатываемого файла. Закройте полностью Word, откройте файл с этой процедурой и запустите. 4. ИЛИ тогда не знаю что еще предложить...
Ну, не знаю... У меня всё катит. Начинаю фантазировать "мозговым штурмом": 1. Уберите этот Trim нафиг, т.е. напишите просто: tbl.Cell(i, 2).Range.Text = arr(0) & sep 2. ИЛИ проверьте Normal.dot: по меню Debug \ Compile Normal - будут ли ошибки? 3. ИЛИ переименуйте процедуру - сделайте с циферкой _3 на конце вместо _2 и поместите ее в модуль обрабатываемого файла. Закройте полностью Word, откройте файл с этой процедурой и запустите. 4. ИЛИ тогда не знаю что еще предложить...Gustav
Работает в таком виде, добавил: On Error Resume Next [vba]
Код
Sub clearEndOfCell_2() Dim arr Dim tbl As Table Dim i As Integer Dim fnd As Find Dim sep As String Set tbl = ActiveDocument.Tables(1)
For i = 1 To tbl.Rows.Count On Error Resume Next Set fnd = tbl.Cell(i, 2).Range.Find
With fnd .Text = "^34^32<[а-яё]@['а-яё]@>" .Replacement.Text = "" .MatchWildcards = True End With
fnd.Execute If fnd.Found Then sep = fnd.Parent.Text arr = Split(tbl.Cell(i, 2).Range.Text, sep) tbl.Cell(i, 2).Range.Text = arr(0) & sep End If Next i End Sub
[/vba]
Работает в таком виде, добавил: On Error Resume Next [vba]
Код
Sub clearEndOfCell_2() Dim arr Dim tbl As Table Dim i As Integer Dim fnd As Find Dim sep As String Set tbl = ActiveDocument.Tables(1)
For i = 1 To tbl.Rows.Count On Error Resume Next Set fnd = tbl.Cell(i, 2).Range.Find
With fnd .Text = "^34^32<[а-яё]@['а-яё]@>" .Replacement.Text = "" .MatchWildcards = True End With
fnd.Execute If fnd.Found Then sep = fnd.Parent.Text arr = Split(tbl.Cell(i, 2).Range.Text, sep) tbl.Cell(i, 2).Range.Text = arr(0) & sep End If Next i End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
А можно как-то нормальными человеческими словами произнести?
