Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Форма для поиска заданного текста на текущем листе Excel с возможностью его окраски
 
#1
23.02.2012 16:02:40
Здравствуйте, уважаемые.    
Необходима форма для поиска заданного текста на текущем листе Excel с возможностью его окраски. Что-то подобное есть здесь http://excelvba.ru/programmes/SearchExcel, но мне бы хотелось быстро (без использования стандартной формы «Найти и заменить») искать и выделять (например, цветом) в очень большом двухмерном массиве ячейки с числами, точно совпадающими с теми, которые будут вводиться в созданную форму. Пожалуйста, помогите кто чем может.
 
 
 
#2
23.02.2012 16:16:05
что именно у вас не получается?
Редко но метко ...
 
 
 
#3
23.02.2012 16:31:12
Вот тот файл, в котором я работаю.    
 
<EM><STRONG>Файл удален</STRONG> - велик размер и, как сказал GIG_ant, ничего не понятно. - [<STRONG>МОДЕРАТОРЫ</STRONG>]</EM>  
<EM><FONT color=#99000><STRONG>Автору настоятельно рекомендована пилюля:</STRONG></FONT><STRONG></STRONG></EM>  
<EM>http://www.planetaexcel.ru/forum.php?thread_id=8735</EM>
 
 
 
#4
23.02.2012 18:02:28
Попробую еще раз.    
Задача проста. Есть большая таблица в ячейках которой необходимо искать определенное числовое значение и выделять его цветом.    
Я вполне понимаю, что это можно сделать при помощи стандартной функции "Найти и заменить", но она меня не устраивает так как програмкой которую я составляю в большинстве случаев будут пользоваться люди не слишком разбирающиеся в тонкостях Excel. Поэтому хотелось бы максимально автоватизировать описанный процесс.    
В дебрях интернета нашел надстройку http://excelvba.ru/programmes/SearchExcel, которая меня бы полностью устроила, если бы можно было закрасить именно те числа, которые вводятся в форму на панели, а не большие, чем введенное. Так вот, мне бы такую же, но с перламутровыми пуговицами ;-).
 
 
 
#5
23.02.2012 18:30:18
Совет:  
Создайте файл с данными, в нем создайте форму для поиска (с нужными вам элементами ввода - текст бокс, кнопки и т. д.), и напишите где чего вводим и куда и что выделяем. Файл сделайте согласно правил.
Редко но метко ...
 
 
 
#6
23.02.2012 20:26:17
Файл создал. В нем еще раз разъяснил свою проблему. Жду помощи. Заранее спасибо!
 
 
 
#7
23.02.2012 21:06:58
Ау! Кто-нубудь!
 
 
 
#8
23.02.2012 21:36:15
Написал последнее сообщение только потому, что в предпоследнем не прописался пользователь и я подумал, что из общей формы с темами не видно, что в теме что-то поменялось.  
То, что сегодня праздник прекрасно понимаю (кстати всех от души поздравляю!!!) С дргой стороны вроде бы во всех постах был достаточно вежлив в просьбе помочь и ни от кого ничего гневно не требовал.  
В своих "объяснялках" изложил все как мог (хотя если перейте по ссылке http://excelvba.ru/programmes/SearchExcel в первом же моем посте станет ясно чего я хочу - тот же функционал, но что бы на листе искались и закрашивались значения вводимые в поле поиска)    
А то, что выложил "лысый" файл, не потрудившись хоть часть своих усилий приложить(создать ТекстБокс или еще что) так я просто не умею этого (2-е недели назад узнал что такое макрос).
 
 
 
#9
23.02.2012 22:14:32
Искать пробовал. Перерыл все. Если бы не искал не нашел бы тот аналог, на который давал ссылку (там код закрыт). Больше ничего хоть сколько нибудь похожего не нашел.    
Макрорекодером пробовал. На записи открыл форму "Найти и заменить", открыл расширенные параметры, проставил все форматы, указал на что должно заменяться вводимое значение. Дамал что при воспроизведении макроса будет отрываться форма с заданными мною параметрами, однако ничего подобного.  
Вообще не понимаю за что я впал в такую не милость.    
Просматривая форум, можно понять, что в большинстве случаев общение выглядит так: человек излагает проблему, если у кого то есть в копилке готовое решение в виде макроса или идея где посмотреть хоть что-то подобное - делятся по доброте душевной (как мне кажется ;-)). Я ни у вас не прошу для меня что-то делать. Потратили на меня время и на том спасибо!
 
 
 
#10
24.02.2012 00:26:29
попробуйте, почти не тестил, написал на быструю руку  
 
Option Explicit  
 
Private Sub CommandButton1_Click()  
   Application.ScreenUpdating = False  
 
   Dim iUR&  
   Dim i&  
   Dim iText  
   iText = UserForm1.TextBox1.Value  
   iUR = Sheets(1).UsedRange.Count  
   If ActiveCell.Interior.Color <> 1 Then  
       For i = 1 To iUR  
           Cells.Find(What:=[iText], After:=ActiveCell).Activate
           Cells.FindNext(After:=ActiveCell).Interior.Color = i  
           Unload UserForm1  
       Next  
   Else  
       MsgBox "Такого значения нет!", vbCritical, ""  
   End If  
 
   Application.ScreenUpdating = True  
End Sub
Киса, я хочу Вас спросить, как художник — художника: Вы рисовать умеете?
 
 
 
#11
24.02.2012 00:33:43
ах да, если будете искать числа с запятой или точкой - необходимо изменить переменную iText на Double  
(Dim iText as Double)
Киса, я хочу Вас спросить, как художник — художника: Вы рисовать умеете?
 
 
 
#12
24.02.2012 12:38:14
Спасибо, The_Prist, LightZ, ночью не тестил (у меня с вами 2-ух часовая разница во времени). Приду чере 2-а часика с работы буду пробовать.
 
 
 
#13
24.02.2012 12:43:34
Исправил  
 
Private Sub CommandButton1_Click()  
   Application.ScreenUpdating = False  
 
   Dim iUR&  
   Dim i&  
   Dim iText As Double  
   iText = UserForm1.TextBox1.Value  
   iUR = Sheets(1).UsedRange.Count  
   If ActiveCell.Interior.Color <> 1 Then  
       For i = 1 To iUR  
           Cells.Find(What:=[iText], After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
           xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _  
           , SearchFormat:=False).Activate  
           Cells.FindNext(After:=ActiveCell).Interior.Color = i  
           Unload UserForm1  
       Next  
   Else  
       MsgBox "Такого значения нет!", vbCritical, ""  
   End If  
 
   Application.ScreenUpdating = True  
End Sub  
 
 
Ps. Если Вы хотите искать числа меняете iText на Double, если текст - меняете на String
Киса, я хочу Вас спросить, как художник — художника: Вы рисовать умеете?
 
 
 
#14
25.02.2012 18:01:51
LightZ, ваш последний код отлично работает, большое спасибо.    
Вчера не смог отписаться поскольку были проблемы с выходом в интернет.    
Если можно ещё один вопрос: у меня ячейка выделяется черным цветом. Это самый не подходящий вариант, поскольку тогда не видно значения в ячейке. Как можно в коде задать другой цвет заливки?
 
 
 
#15
25.02.2012 18:21:29
Может лучше использовать УФ?  
Ну а если очень нужна форма - можно из формы заносить значение в ячейку или присваивать его имени.
 
 
 
#16
25.02.2012 18:35:46
С именем.
 
 
 
#17
25.02.2012 19:06:46
{quote}{login=Hugo}{date=25.02.2012 06:21}{thema=}{post}Может лучше использовать УФ?  
Ну а если очень нужна форма - можно из формы заносить значение в ячейку или присваивать его имени.{/post}{/quote}  
Нет это совсем не то.    
Мне нужно помечать номера (это земельные участки). Которые я только что использовал. Это надо будет делать много раз. В итоге они будут использованы и отмечены все.
 
 
 
#18
25.02.2012 19:16:42
{quote}{login=GeoX}{date=25.02.2012 06:01}{thema=}{post}LightZ, ваш последний код отлично работает, большое спасибо.{/post}{/quote}  
Извиняюсь, помоему я немного погрячился. Пока тестировал на небольшом фрагменте все было хорошо. Однако когда установил на свой рабочий лист с очень большим объемом цифр всплыли следующие проблемы:  
1. Самая главная проблема в том, что на большом массиве данных поиск осуществляется очень долго (3 мин.)  
2. Почему, то используются одновременно разные цвета для заливки ячеек с одними и теми же значениями.  
3. При замене iText на iText As String (для поиска только по текстовым форматам)  
ячеек все равно выделяет например и зачение 22 заданное как число и 22 заданное как текст.
 
 
 
#19
25.02.2012 19:40:03
{quote}{login=Hugo}{date=25.02.2012 06:35}{thema=}{post}С именем.{/post}{/quote}  
Hugo, плюсы вашей версии: ищет быстро, окрашивает в одинаковый приемлемый цвет.  
Минусы - заливка после следующего ввода значения на прежних ячейках не остается, а надо что бы оставалась. И требуется, что бы поиск осуществлялся только по ячейкам с текстовым форматом.  
И я не смог посмотреть ваш основной код. Как это сделать? В предыдущем случае (в варианте от LightZ) я то же не понял как и куда он вбит, но вызывал его вводя в форму поиска заведомо большее число чем есть в таблице и затем нажимая кнопку Debug (Я еще весьма тёмен в этих делах)
 
 
 
#20
25.02.2012 19:45:46
У меня там практически никакого кода нет (разве что  форма LightZ и в ней одна стока присвоения значения имени - во втором файле).  
Всё делает УФ - условное форматирование.  
Но для Вашей задачи это не годится, если нужно отмечать все выбранные и ранее номера.
 
 
 
#21
25.02.2012 19:47:58
К сожалению не подходит, но все равно спасибо.
 
 
 
#22
25.02.2012 20:18:04
Нужно тестить  
 
   Dim i As Long  
   Dim j As Long  
   Dim iLastrow As Long  
   Dim iLastcol As Long  
   Dim iPoisk As String  
 
   iPoisk = UserForm1.TextBox1.Value  
   iLastrow = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row  
   iLastcol = Range("A1").CurrentRegion.Columns.Count  
 
   For i = 1 To iLastrow  
       For j = 1 To iLastcol  
           If Range(Cells(i, j), Cells(i, j)).Value = [iPoisk] Then
               Range(Cells(i, j), Cells(i, j)).Cells.Interior.Color = 65535  
           End If  
       Next  
   Next
Киса, я хочу Вас спросить, как художник — художника: Вы рисовать умеете?
 
 
 
#23
25.02.2012 21:19:48
Добавил примо в ваш файл свои цифры, закрашивает только из тех цифр которые были и выдает ошибку:  
If Range(Cells(i, j), Cells(i, j)).Value = [iPoisk] Then
 
 
 
#24
25.02.2012 21:32:10
If Range(Cells(i, j), Cells(i, j)).Value = [iPoisk] Then
Range(Cells(i, j), Cells(i, j)).Cells.Interior.Color = 65535  
End If  
 
можно сократить углУбить:  
If Cells(i, j).Value = [iPoisk] Then
Cells(i, j).Interior.Color = 65535  
Else  
Cells(i, j).Interior.ColorIndex = xlNone 'убрать следы старых поисков  
End If
 
 
 
#25
25.02.2012 22:04:32
Дык старые следы нужны.  
Иначе УФ выгоднее.
 
 
 
#26
25.02.2012 22:41:01
Читал не внимательно. Виноват.
 
 
 
#27
26.02.2012 00:19:40
{quote}{login=GeoX}{date=25.02.2012 09:19}{thema=}{post}...выдает ошибку...{/post}{/quote}  
 
Вставил форму в Ваш файл - всё работает на ура.  
Что у Вас не так?
Киса, я хочу Вас спросить, как художник — художника: Вы рисовать умеете?
 
 
 
#28
27.02.2012 00:15:24
Усовершенствовал  
Может в копилку? :)  
 
 
Sub Поиск_циклом()  
'ищем с помощью цикла и перекрашиваем в желтый цвет  
'вызвать с помощью Ctrl+q  
 
   Dim i As Long  
   Dim j As Long  
   Dim iLastrow As Long  
   Dim iLastcol As Long  
   Dim iPoisk As String  
   Dim x  
     
   x = Application.InputBox("Ввести значение для поиска", "", "(пусто)")  
   iPoisk = x  
   iLastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row  
   iLastcol = Range("A1").CurrentRegion.Columns.Count  
   For i = 1 To iLastrow  
       For j = 1 To iLastcol  
           With Range(Cells(i, j), Cells(i, j))  
               If .Value = [iPoisk] Then
                   .Cells.Interior.Color = 65535  
               End If  
           End With  
       Next  
   Next  
End Sub
Киса, я хочу Вас спросить, как художник — художника: Вы рисовать умеете?
 
 
 
Страницы: 1
Читают тему
Наверх