Макрос на выделение цветом найденную запись

@alex94 · Регистрация: 05.07.2014

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

здравствуйте, данный макрос находит заданное значение и выделяет его цветом

PureBasic

Sub Finderer()
Dim FD, firstAddress, adrs
FD = InputBox("ВВЕДИТЕ ИСКОМОЕ СЛОВО ИЛИ ЧИСЛО", "Мой поиск")
If FD = "" Then Exit Sub ' если пользователь нажал кнопку ОТМЕНА - отказ от поиска
Dim c As Range: Set c = Range("A:A").Find(FD) ' поиск данных
' если ничего не нашли - выход из макроса
If c Is Nothing Then MsgBox "Искомые данные не найдены", vbExclamation: Exit Sub
firstAddress = c.Address
c.Select
Do
adrs = adrs & vbLf & c.Address(0, 0)
Union(Selection, c).Select
Set c = Range("A:A").FindNext(c)
Loop While c.Address <> firstAddress
Selection.interior.colorindex=3 
MsgBox "Значение """ & FD & """ найдено в ячейке (ячейках):" & adrs, vbInformation
End Sub

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

shanemac51 · 01.12.2015, 09:35

Visual Basic

Sub Finderer01()
Dim FD, firstAddress, adrs
Dim c As Range
 
Do While True
FD = InputBox("ВВЕДИТЕ ИСКОМОЕ СЛОВО ИЛИ ЧИСЛО", "Мой поиск")
If FD = "" Then
Exit Sub ' если пользователь нажал кнопку ОТМЕНА - отказ от поиска
End If
Set c = Range("A:A").Find(FD) ' поиск данных
' если ничего не нашли - выход из макроса
If c Is Nothing Then
MsgBox "Искомые данные не найдены", vbExclamation
Exit Sub
End If
firstAddress = c.Address
c.Select
Do
adrs = adrs & vbLf & c.Address(0, 0)
Union(Selection, c).Select
Set c = Range("A:A").FindNext(c)
Loop While c.Address <> firstAddress
Selection.Interior.ColorIndex = 3
MsgBox "Значение """ & FD & """ найдено в ячейке (ячейках):" & adrs, vbInformation
Loop
End Sub

@alex94 · 01.12.2015, 10:33 **[ТС]**

Сообщение от shanemac51

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
Sub Finderer01()
Dim FD, firstAddress, adrs
Dim c As Range
Do While True
FD = InputBox("ВВЕДИТЕ ИСКОМОЕ СЛОВО ИЛИ ЧИСЛО", "Мой поиск")
If FD = "" Then
Exit Sub ' если пользователь нажал кнопку ОТМЕНА - отказ от поиска
End If
Set c = Range("A:A").Find(FD) ' поиск данных
' если ничего не нашли - выход из макроса
If c Is Nothing Then
MsgBox "Искомые данные не найдены", vbExclamation
Exit Sub
End If
firstAddress = c.Address
c.Select
Do
adrs = adrs & vbLf & c.Address(0, 0)
Union(Selection, c).Select
Set c = Range("A:A").FindNext(c)
Loop While c.Address <> firstAddress
Selection.Interior.ColorIndex = 3
MsgBox "Значение """ & FD & """ найдено в ячейке (ячейках):" & adrs, vbInformation
Loop
End Sub

Большое спасибо, все отлично работает!!!

@alex94 0 / 0 / 0 Регистрация: 05.07.2014 Сообщений: 58
	01.12.2015, 10:33 [ТС]	3
	Сообщение от shanemac51 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 Sub Finderer01() Dim FD, firstAddress, adrs Dim c As Range Do While True FD = InputBox("ВВЕДИТЕ ИСКОМОЕ СЛОВО ИЛИ ЧИСЛО", "Мой поиск") If FD = "" Then Exit Sub ' если пользователь нажал кнопку ОТМЕНА - отказ от поиска End If Set c = Range("A:A").Find(FD) ' поиск данных ' если ничего не нашли - выход из макроса If c Is Nothing Then MsgBox "Искомые данные не найдены", vbExclamation Exit Sub End If firstAddress = c.Address c.Select Do adrs = adrs & vbLf & c.Address(0, 0) Union(Selection, c).Select Set c = Range("A:A").FindNext(c) Loop While c.Address <> firstAddress Selection.Interior.ColorIndex = 3 MsgBox "Значение """ & FD & """ найдено в ячейке (ячейках):" & adrs, vbInformation Loop End Sub Большое спасибо, все отлично работает!!! 0