Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Поиск значений в книге (по слову) и вывод их в столбец - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Поиск значений в книге (по слову) и вывод их в столбец (Макросы/Sub)
Поиск значений в книге (по слову) и вывод их в столбец
odeon16 Дата: Четверг, 27.07.2017, 09:16 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 78
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Доброе утро, форумчане.
Помогите разобраться с проблемой.

Есть рабочая книга с несколькими листами.
На листах разбросаны желтые, красные и синие ячейки с разными надписями, например Один (в желтых ячейках), Два (в синих), Три (в красных).

Рядом с каждой ячейкой есть еще несколько зеленых ячеек.
Каждая зеленая ячейка - расположена от желтой - на разных расстояниях.
В зеленые ячейки - вписаны разнообразные символы.

На листе4 есть столбец, в заголовке которого стоит одно из слов, записанных в желтую ячейку - например слово "Один".

Как макросом вывести в этот столбец - содержимое зеленых ячеек (на разных листах), расположенных в непосредственной близости с желтыми ячейками ?
(поиск идет - по тексту вписанному в ячейку F7 листа4. В данном случае - по слову "Один")
(Те зеленые ячейки, что не соседствуют с желтой, то есть находятся в некотором отдалении - не воспринимаются)
К сообщению приложен файл: 28678.xls(33Kb)
 
Ответить
СообщениеДоброе утро, форумчане.
Помогите разобраться с проблемой.

Есть рабочая книга с несколькими листами.
На листах разбросаны желтые, красные и синие ячейки с разными надписями, например Один (в желтых ячейках), Два (в синих), Три (в красных).

Рядом с каждой ячейкой есть еще несколько зеленых ячеек.
Каждая зеленая ячейка - расположена от желтой - на разных расстояниях.
В зеленые ячейки - вписаны разнообразные символы.

На листе4 есть столбец, в заголовке которого стоит одно из слов, записанных в желтую ячейку - например слово "Один".

Как макросом вывести в этот столбец - содержимое зеленых ячеек (на разных листах), расположенных в непосредственной близости с желтыми ячейками ?
(поиск идет - по тексту вписанному в ячейку F7 листа4. В данном случае - по слову "Один")
(Те зеленые ячейки, что не соседствуют с желтой, то есть находятся в некотором отдалении - не воспринимаются)

Автор - odeon16
Дата добавления - 27.07.2017 в 09:16
sboy Дата: Четверг, 27.07.2017, 12:14 | Сообщение № 2
Группа: Проверенные
Ранг: Старожил
Сообщений: 1015
Репутация: 255 ±
Замечаний: 0% ±

Excel 2010
Добрый день.
Не понял про цвет ячеек, он только для наглядности примера? или в желтой ячейке может быть и "два" и "три"
Сделал без цвета[vba]
Код
Sub Овал1_Щелчок()
sText = Range("F7").Value
Range("F8:F100").ClearContents
Dim arr()
ReDim arr(0)
    For x = 1 To 3
        With Sheets(x).UsedRange
        Set cl = .Find(sText, LookIn:=xlValues, lookat:=xlWhole)
            If Not cl Is Nothing Then
                firstAddress = cl.Address
                Do
                   For r = -1 To 1
                        For c = -1 To 1
                            q = cl.Offset(r, c).Value
                            If Not IsEmpty(q) And IsNumeric(q) Then
                    arr(UBound(arr)) = q
                    ReDim Preserve arr(UBound(arr) + 1)
                            End If
                        Next c
                    Next r
                    Set cl = .FindNext(cl)
                Loop While Not cl Is Nothing And cl.Address <> firstAddress
            End If
        End With
    Next x
    Range("F8").Resize(UBound(arr) + 1, 1) = WorksheetFunction.Transpose(arr)
End Sub
[/vba]
К сообщению приложен файл: 8419069.xls(50Kb)
 
Ответить
СообщениеДобрый день.
Не понял про цвет ячеек, он только для наглядности примера? или в желтой ячейке может быть и "два" и "три"
Сделал без цвета[vba]
Код
Sub Овал1_Щелчок()
sText = Range("F7").Value
Range("F8:F100").ClearContents
Dim arr()
ReDim arr(0)
    For x = 1 To 3
        With Sheets(x).UsedRange
        Set cl = .Find(sText, LookIn:=xlValues, lookat:=xlWhole)
            If Not cl Is Nothing Then
                firstAddress = cl.Address
                Do
                   For r = -1 To 1
                        For c = -1 To 1
                            q = cl.Offset(r, c).Value
                            If Not IsEmpty(q) And IsNumeric(q) Then
                    arr(UBound(arr)) = q
                    ReDim Preserve arr(UBound(arr) + 1)
                            End If
                        Next c
                    Next r
                    Set cl = .FindNext(cl)
                Loop While Not cl Is Nothing And cl.Address <> firstAddress
            End If
        End With
    Next x
    Range("F8").Resize(UBound(arr) + 1, 1) = WorksheetFunction.Transpose(arr)
End Sub
[/vba]

Автор - sboy
Дата добавления - 27.07.2017 в 12:14
odeon16 Дата: Четверг, 27.07.2017, 13:05 | Сообщение № 3
Группа: Пользователи
Ранг: Участник
Сообщений: 78
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Не понял про цвет ячеек, он только для наглядности примера?

Да - чисто для наглядности.
 
Ответить
Сообщение
Не понял про цвет ячеек, он только для наглядности примера?

Да - чисто для наглядности.

Автор - odeon16
Дата добавления - 27.07.2017 в 13:05
odeon16 Дата: Четверг, 27.07.2017, 13:16 | Сообщение № 4
Группа: Пользователи
Ранг: Участник
Сообщений: 78
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
sboy, все работает как надо.
Спасибо.
 
Ответить
Сообщениеsboy, все работает как надо.
Спасибо.

Автор - odeon16
Дата добавления - 27.07.2017 в 13:16
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Поиск значений в книге (по слову) и вывод их в столбец (Макросы/Sub)
Страница 1 из 11
Поиск:

Яндекс цитирования
© 2010-2017 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!