Поиск текста с выводом адреса ячейки

@yl3d · Регистрация: 28.09.2015

Студворк — интернет-сервис помощи студентам

Добрый вечер, специалисты по экселю.
Помогите разобраться с проблемой.

В книге несколько листов.
На листах 1,2,3,4 в некоторых ячейках находится текст.
На листе "Поиск" - находится столбец C5:C17 - в котором вписаны слова, по которым я хочу осуществить поиск.

Как макросом - провести поиск ключевых слов по листам 1,2,3,4 и вывести найденный текст - в третью строку листа "Поиск" - с выводом адреса ячейки, в которой был найден этот текст ?

@Vlad999 · 08.09.2017, 11:06

на листе один текст всегда в одном экземпляре?

@yl3d · 08.09.2017, 11:11 **[ТС]**

Vlad999 , нет - может быть несколько ячеек с похожим текстом

@Vlad999 · 08.09.2017, 11:22

для одного.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub vvv()
Dim Ws As Worksheet, i%, FR As Range, adr$, f$
For i = 5 To Cells(Rows.Count, 3).End(xlUp).Row
f = Cells(i, 3).Value
    For Each Ws In Sheets
    If Ws.Name <> "Поиск" Then
       Set FR = Ws.Cells.Find(f)
       If Not FR Is Nothing Then adr = adr & " " & Ws.Name & "!" & FR.Address
    End If
    Next
Cells(i, 5) = adr
adr = ""
Next
End Sub

для нескольких чуть позже. пока занят.

@yl3d · 08.09.2017, 12:26 **[ТС]**

Vlad999 , ясно

@Vlad999 · 08.09.2017, 12:43

yl3d, результат записывать в одну ячейку или один адрес - одна ячейка?

Добавлено через 6 минут
проверяйте

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Sub vvv()
Dim Ws As Worksheet, i%, FR As Range, adr$, f$, a$, ms()
For i = 5 To Cells(Rows.Count, 3).End(xlUp).Row
f = Cells(i, 3).Value
    For Each Ws In Sheets
    If Ws.Name <> "Поиск" Then
       Set FR = Ws.Cells.Find(f)
       If Not FR Is Nothing Then
          adr = adr & " " & Ws.Name & "!" & FR.Address
          '---цикл по следующим найденным ячейкам
          a = FR.Address '---запоминаем адрес первой найденной ячейки
          Do
            Set FR = Ws.Cells.FindNext(FR)
            If FR.Address = a Then Exit Do
            adr = adr & " " & Ws.Name & "!" & FR.Address
          Loop
          '-----------
        End If
    End If
    Next
'Cells(i, 5) = adr 'если в одну
'если один адрес - одна ячейка
ms = Split(Mid(adr, 2, 1000))
Cells(i, 5).Resize(, UBound(ms) + 1) = ms
'-------------------------
adr = ""
Next
End Sub

@yl3d · 08.09.2017, 13:16 **[ТС]**

Vlad999 , один адрес- одна ячейка.

Добавлено через 29 минут
Vlad999 , не работает.
Выдает ошибку "run-time error '13': Type mistmatch"
и подсвечивает строку кода: ms = Split(Mid(adr, 2, 1000))

@Vlad999 · 08.09.2017, 13:31

1. уберите скобки у ms

Visual Basic
1
Dim ms

2. замените часть кода, это еще одна проверка если искомое не найдено.

Visual Basic
1
2
3
4
If adr <> "" Then
  ms = Split(Mid(adr, 2, 1000))
  Cells(i, 5).Resize(, UBound(ms) + 1) = ms
End If

@yl3d · 08.09.2017, 15:30 **[ТС]**

Vlad999 , спасибо большое.
Все работает.

@arturik3 · 25.02.2022, 13:06

Добрый день,

очень полезный макрос

подскажите пожалуйста как решить проблему, если макрос обрабатывает значение которого нет на листах, то он спотыкается, как этого избежать?

@Vlad999 · 25.02.2022, 15:44

файл показываем, и что ищете в нем?

@arturik3 · 25.02.2022, 15:57

я взял файл из этой темы, добавил все изменения и ввел в столбец с исходными данными новое значение, которое заведомо отсутствует, скрипт выдает ошибку на нем, файл с расширением .xlsm не дает загрузить

Добавлено через 2 минуты

Code
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Sub vvv()
Dim Ws As Worksheet, i%, FR As Range, adr$, f$, a$, ms
For i = 5 To Cells(Rows.Count, 3).End(xlUp).Row
f = Cells(i, 3).Value
    For Each Ws In Sheets
    If Ws.Name <> "Search" Then
       Set FR = Ws.Cells.Find(f)
             If Not FR Is Nothing Then
          adr = adr & " " & Ws.Name & "!" & FR.Address
          '---
          a = FR.Address
          Do
            Set FR = Ws.Cells.FindNext(FR)
            If FR.Address = a Then Exit Do
            adr = adr & " " & Ws.Name & "!" & FR.Address
                        Loop
          '-----------
        
        End If
    End If
    Next
'Cells(i, 5) = adr 
ms = Split(Mid(adr, 2, 1000))
Cells(i, 5).Resize(, UBound(ms) + 1) = ms
'-------------------------
 adr = ""
 
Next
 If adr <> "" Then
  ms = Split(Mid(adr, 2, 1000))
  Cells(i, 5).Resize(, UBound(ms) + 1) = ms
End If
End Sub

@arturik3 · 25.02.2022, 16:03

заменил .xlsm на .xls

@Vlad999 · 25.02.2022, 16:59

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Sub vvv()
Dim Ws As Worksheet, i%, FR As Range, adr$, f$, a$, ms
For i = 5 To Cells(Rows.Count, 3).End(xlUp).Row
f = Cells(i, 3).Value
    For Each Ws In Sheets
    If Ws.Name <> "Search" Then
    Set FR = Ws.Cells.Find(f)
        If Not FR Is Nothing Then
              adr = adr & " " & Ws.Name & "!" & FR.Address
              a = FR.Address
            Do
                Set FR = Ws.Cells.FindNext(FR)
                If FR.Address = a Then Exit Do
                adr = adr & " " & Ws.Name & "!" & FR.Address
            Loop
        End If
    End If
Next
If adr <> "" Then
  ms = Split(Mid(adr, 2, 1000))
  Cells(i, 5).Resize(, UBound(ms) + 1) = ms
  adr = ""
End If
Next
End Sub

Новые блоги и статьи Все статьи Все блоги /
Модель заражения группы наркоманов alhaos 17.04.2026 Условия задачи сформулированы тут Суть: - Группа наркоманов из 10 человек. - Только один инфицирован ВИЧ. - Колются одной иглой. - Колются раз в день. - Колются последовательно через. . .	Мысли в слух. Про "навсегда". kumehtar 16.04.2026 Подумалось тут, что наверное очень глупо использовать во всяких своих установках понятие "навсегда". Это очень сильное понятие, и я только начинаю понимать край его смысла, не смотря на то что давно. . .	My Business CRM MaGz GoLd 16.04.2026 Всем привет, недавно возникла потребность создать CRM, для личных нужд. Собственно программа предоставляет из себя базу данных клиентов, в которой можно фиксировать звонки, стадии сделки, а также. . .	Знаешь почему 90% людей редко бывают счастливыми? kumehtar 14.04.2026 Потому что они ждут. Ждут выходных, ждут отпуска, ждут удачного момента. . . а удачный момент так и не приходит.
Фиксация колонок в отчете СКД Maks 14.04.2026 Фиксация колонок в СКД отчета типа Таблица. Задача: зафиксировать три левых колонки в отчете. Процедура ПриКомпоновкеРезультата(ДокументРезультат, ДанныеРасшифровки, СтандартнаяОбработка) / / . . .	Настройки VS Code Loafer 13.04.2026 { "cmake. configureOnOpen": false, "diffEditor. ignoreTrimWhitespace": true, "editor. guides. bracketPairs": "active", "extensions. ignoreRecommendations": true, . . .	Оптимизация кода на разграничение прав доступа к элементам формы Maks 13.04.2026 Алгоритм из решения ниже реализован на нетиповом документе, разработанного в конфигурации КА2. Задачи, как таковой, поставлено не было, проделанное ниже исключительно моя инициатива. Было так:. . .	Контроль заполнения и очистка дат в зависимости от значения перечислений Maks 12.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеПерсонала", разработанного в конфигурации КА2. Задача: реализовать контроль корректности заполнения дат назначения. . .

@Vlad999 3947 / 2340 / 790 Регистрация: 02.11.2012 Сообщений: 6,220
	08.09.2017, 11:06
	на листе один текст всегда в одном экземпляре? 0

@yl3d 3 / 3 / 1 Регистрация: 28.09.2015 Сообщений: 271
	08.09.2017, 11:11 [ТС]
	Vlad999 , нет - может быть несколько ячеек с похожим текстом 0

@yl3d 3 / 3 / 1 Регистрация: 28.09.2015 Сообщений: 271
	08.09.2017, 12:26 [ТС]
	Vlad999 , ясно 0

@yl3d 3 / 3 / 1 Регистрация: 28.09.2015 Сообщений: 271
	08.09.2017, 13:16 [ТС]
	Vlad999 , один адрес- одна ячейка. Добавлено через 29 минут Vlad999 , не работает. Выдает ошибку "run-time error '13': Type mistmatch" и подсвечивает строку кода: ms = Split(Mid(adr, 2, 1000)) 0

@yl3d 3 / 3 / 1 Регистрация: 28.09.2015 Сообщений: 271
	08.09.2017, 15:30 [ТС]
	Vlad999 , спасибо большое. Все работает. 0

@arturik3 0 / 0 / 0 Регистрация: 22.02.2022 Сообщений: 3
	25.02.2022, 13:06
	Добрый день, очень полезный макрос подскажите пожалуйста как решить проблему, если макрос обрабатывает значение которого нет на листах, то он спотыкается, как этого избежать? 0

@Vlad999 3947 / 2340 / 790 Регистрация: 02.11.2012 Сообщений: 6,220
	25.02.2022, 15:44
	файл показываем, и что ищете в нем? 0

Поиск текста с выводом адреса ячейки

Решение