Добрый день! Есть таблица, в ней существуют разделы. У каждого раздела есть строки, у которых есть примечания. У каждого раздела примечания разные. Вопрос: можно по примечаниям выделить строки и скопировать их на отдельный лист?
Добрый день! Есть таблица, в ней существуют разделы. У каждого раздела есть строки, у которых есть примечания. У каждого раздела примечания разные. Вопрос: можно по примечаниям выделить строки и скопировать их на отдельный лист?Гость
Я нашел код, осуществляющий поиск указанного текста во всех примечаниях, но он выдает ошибку в строках, содержаших Ме. Что можно придумать?
[vba]
Код
Private Sub SearchTextInComments() iSearchText$ = "текст"
Dim iCell As Range Set iCell = Me.UsedRange.Find _ (What:=iSearchText$, LookIn:=xlComments, LookAt:=xlPart)
If Not iCell Is Nothing Then iAddress$ = iCell.Address Do iCell.Comment.Visible = True Set iCell = Me.UsedRange.FindNext(After:=iCell) Loop While Not iCell Is Nothing And iCell.Address <> iAddress$ End If End Sub
[/vba]
Я нашел код, осуществляющий поиск указанного текста во всех примечаниях, но он выдает ошибку в строках, содержаших Ме. Что можно придумать?
[vba]
Код
Private Sub SearchTextInComments() iSearchText$ = "текст"
Dim iCell As Range Set iCell = Me.UsedRange.Find _ (What:=iSearchText$, LookIn:=xlComments, LookAt:=xlPart)
If Not iCell Is Nothing Then iAddress$ = iCell.Address Do iCell.Comment.Visible = True Set iCell = Me.UsedRange.FindNext(After:=iCell) Loop While Not iCell Is Nothing And iCell.Address <> iAddress$ End If End Sub
В общем-то ничего особенно много добавлять не пришлось:
[vba]
Код
Private Sub SearchTextInComments() Dim iSearchText$: iSearchText$ = "текст"
Dim iCell As Range, i As Long, iAddress$
With Workbooks.Add.Sheets(1)
Set iCell = Me.UsedRange.Find _ (What:=iSearchText$, LookIn:=xlComments, LookAt:=xlPart)
If Not iCell Is Nothing Then iAddress$ = iCell.Address Do i = i + 1 Rows(iCell.Row).Copy .Cells(i, 1) 'iCell.Comment.Visible = True Set iCell = Me.UsedRange.FindNext(After:=iCell) Loop While Not iCell Is Nothing And iCell.Address <> iAddress$ End If
End With End Sub
[/vba]
В общем-то ничего особенно много добавлять не пришлось:
[vba]
Код
Private Sub SearchTextInComments() Dim iSearchText$: iSearchText$ = "текст"
Dim iCell As Range, i As Long, iAddress$
With Workbooks.Add.Sheets(1)
Set iCell = Me.UsedRange.Find _ (What:=iSearchText$, LookIn:=xlComments, LookAt:=xlPart)
If Not iCell Is Nothing Then iAddress$ = iCell.Address Do i = i + 1 Rows(iCell.Row).Copy .Cells(i, 1) 'iCell.Comment.Visible = True Set iCell = Me.UsedRange.FindNext(After:=iCell) Loop While Not iCell Is Nothing And iCell.Address <> iAddress$ End If
Чтобы не было ошибки либо, как советовал Игорь, поместите код в модуль листа, либо замените Me не ActiveSheet Но ведь вам, кажется, нужно было не определённый текст искать, а
Quote (Гость)
Есть таблица, в ней существуют разделы. У каждого раздела есть строки, у которых есть примечания. У каждого раздела примечания разные. Вопрос: можно по примечаниям выделить строки и скопировать их на отдельный лист?
Ну так дайте ссылку на файл-пример таблицы. Не нам же её за вас придумывать. Тем более, что понятия "Раздел" в Экселе не существует и мы можем только гадать, что вы имеете в виду...
Чтобы не было ошибки либо, как советовал Игорь, поместите код в модуль листа, либо замените Me не ActiveSheet Но ведь вам, кажется, нужно было не определённый текст искать, а
Quote (Гость)
Есть таблица, в ней существуют разделы. У каждого раздела есть строки, у которых есть примечания. У каждого раздела примечания разные. Вопрос: можно по примечаниям выделить строки и скопировать их на отдельный лист?
Ну так дайте ссылку на файл-пример таблицы. Не нам же её за вас придумывать. Тем более, что понятия "Раздел" в Экселе не существует и мы можем только гадать, что вы имеете в виду...Alex_ST
Спасибо, с ActiveSheet ошибку не выдает, но оказалось в поиске ничего не находит, просто создает пустую книгу. Ссылку на файл выложить не получается .
Спасибо, с ActiveSheet ошибку не выдает, но оказалось в поиске ничего не находит, просто создает пустую книгу. Ссылку на файл выложить не получается .Гость
Ребят, помогите!!!! Нужна кнопка поиска в примечаниях! Основу взял с сайта http://excelvba точка ru/code/HighlightText Там поиск идет на странице, а не в примечаниях, как мне надо.... пытался дополнить ее командами из этой темы:
[vba]
Код
Dim iCell As Range Set iCell = Me.UsedRange.Find _ (What:=iSearchText$, LookIn:=xlComments, LookAt:=xlPart)
[/vba]
но ничего не получается...
я нуб!
Ребят, помогите!!!! Нужна кнопка поиска в примечаниях! Основу взял с сайта http://excelvba точка ru/code/HighlightText Там поиск идет на странице, а не в примечаниях, как мне надо.... пытался дополнить ее командами из этой темы:
[vba]
Код
Dim iCell As Range Set iCell = Me.UsedRange.Find _ (What:=iSearchText$, LookIn:=xlComments, LookAt:=xlPart)
Основу взял с сайта http://excelvba точка ru/code/HighlightText Там поиск идет на странице, а не в примечаниях, как мне надо....
Я расшифрую для тех, кто не может туда попасть или это могут стереть. Я думаю, поиск в примечаниях пригодится не только мне, в связи с этим выложу исходный код кнопки:
[vba]
Код
Option Compare Text
Sub Find_n_Highlight() On Error Resume Next: Err.Clear Dim ra As Range, cell As Range, res, txt$, v, pos& res = InputBox("Введите наименование организации, которую необходимо найти в календаре", "Поиск текста", "насхульян") If VarType(res) = vbBoolean Then Exit Sub ' нажата кнопка ОТМЕНА txt$ = Trim(res): If Len(txt) = 0 Then Exit Sub ' текст не введен, или состоит из пробелов
Set ra = Range([A2], Range("A" & Rows.Count).End(xlUp)) ' диапазон для поиска Application.ScreenUpdating = False ra.Font.Color = 0: ra.Font.Bold = 0 ' сброс цветового выделения
For Each cell In ra.Cells ' перебираем все ячейки pos = 1 If cell.Text Like "*" & txt & "*" Then arr = Split(cell.Text, txt, , vbTextCompare) ' разбивает текст ячейки на части If UBound(arr) > 0 Then ' если подстрока найдена For Each v In arr ' перебираем все вхождения pos = pos + Len(v) ' начальная позиция With cell.Characters(pos, Len(txt)) .Font.ColorIndex = 3 ' выделяем цветом .Font.Bold = True ' и полужирным начертанием End With pos = pos + Len(txt) Next v End If End If Next cell End Sub
[/vba]
Цитата (Нострадамус обыкновенный)
Основу взял с сайта http://excelvba точка ru/code/HighlightText Там поиск идет на странице, а не в примечаниях, как мне надо....
Я расшифрую для тех, кто не может туда попасть или это могут стереть. Я думаю, поиск в примечаниях пригодится не только мне, в связи с этим выложу исходный код кнопки:
[vba]
Код
Option Compare Text
Sub Find_n_Highlight() On Error Resume Next: Err.Clear Dim ra As Range, cell As Range, res, txt$, v, pos& res = InputBox("Введите наименование организации, которую необходимо найти в календаре", "Поиск текста", "насхульян") If VarType(res) = vbBoolean Then Exit Sub ' нажата кнопка ОТМЕНА txt$ = Trim(res): If Len(txt) = 0 Then Exit Sub ' текст не введен, или состоит из пробелов
Set ra = Range([A2], Range("A" & Rows.Count).End(xlUp)) ' диапазон для поиска Application.ScreenUpdating = False ra.Font.Color = 0: ra.Font.Bold = 0 ' сброс цветового выделения
For Each cell In ra.Cells ' перебираем все ячейки pos = 1 If cell.Text Like "*" & txt & "*" Then arr = Split(cell.Text, txt, , vbTextCompare) ' разбивает текст ячейки на части If UBound(arr) > 0 Then ' если подстрока найдена For Each v In arr ' перебираем все вхождения pos = pos + Len(v) ' начальная позиция With cell.Characters(pos, Len(txt)) .Font.ColorIndex = 3 ' выделяем цветом .Font.Bold = True ' и полужирным начертанием End With pos = pos + Len(txt) Next v End If End If Next cell End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
.
