Есть. Условное форматирование, ВПР, ПОИСКПОЗ..

Была такая тема, поищите. Может, откликнутся те, кто в ней активно участвовал (я - нет).

У меня файл сохранён как Nilem - Сортировка ячеек с цифрами по маске - post_254305.xls Т.е. ищем post_254305.xls http://www.planetaexcel.ru/forum.php?thread_id=31071&page_forum=2&allnum_forum=62

Примерно так..  
Sub tt()  
Const maska = "1123"  
Dim i&, a  
a = [A1:A10000]
For i = 1 To UBound(a)  
If a(i, 1) Like "*" & maska & "*" Then [B2] = [A1]
Next  
End Sub

Попробовал с регулярными, вроде бы все просто:  
 
Sub bb()  
Dim x  
With CreateObject("vbscript.regexp")  
   .Pattern = "(.)(.)\1\2"  
   For Each x In [A1:A10000].Value
       If .test(x) Then Debug.Print x  
   Next  
End With  
End Sub  
 
Даже можно написать "переводчик" строк типа "xxyy" на язык регулярных.  
Но! Если х и у - обязательно разные цифры, то такая простая маска не пройдет.  
Написать условие типа "не равно предыдущему найденному" у меня не получилось - может, кто-то сделает?  
Можно, конечно, заменить .test на .execute и просмотреть коллекцию подстрок - если все они различны, то условие выполнено.  
Но опять проблема: допустим, число 7777474. По использованной в коде маске будет найдено "7777", но подстроки одинаковы и условие не выполнено. А "правильная" подстрока "7474" найдена не будет.

Sub Макрос1()  
 
  Dim MyCheck  
  Dim myRange As Range  
   Set myRange = Worksheets(1).Range("A2:A10000") 'с 2-й строки,если есть шапка  
MyValue = InputBox("Введите маску поиска")  
 
For Each chislo In myRange  
MyCheck = Str(chislo)  
Poisk = InStr(1, MyCheck, MyValue)  
 
   If Poisk <> 0 Then  
       chislo.Select  
    Selection.Offset(0, 1).Select 'в ячейке справа(В) проставим признак 1  
       Selection.Value = 1  
   End If  
Next  
 
End Sub

ALT F8  
выполнить Макрос1

{quote}{login=}{date=02.02.2012 02:24}{thema=}{post}Ничего не могу понять.  
Печалька.(  
 
http://forum.msexcel.ru/microsoft_excel/vyborka_krasivyh_nomerov-t5937.0.html - вот что мне нужно, занимаюсь именно этим! Но не могу понять как что надо делать... вот хоть убейте! Ну чайник я совсем!{/post}{/quote}  
Начните с того, что выложите пример в виде "что есть" и "что хочу" в соответствии с правилами форума.  
В качестве примера выкладываю файл из указанной ссылки, может это прояснит ситуацию

Заготовка:  
 
Sub tt()  
Dim a(), i&, t(1 To 4)  
a = [a1].CurrentRegion.Value
For i = 1 To UBound(a)  
t(1) = Mid(a(i, 1), 7, 1)  
t(2) = Mid(a(i, 1), 8, 1)  
t(3) = Mid(a(i, 1), 9, 1)  
t(4) = Mid(a(i, 1), 10, 1)  
 
Select Case True  
Case t(1) = t(3) And t(2) = t(4): MsgBox a(i, 1)  
End Select  
 
Next  
 
End Sub  
 
Развить, добавить вывод по массивам (быстро) или сразу по листам (медленно).

Следующий шаг (не стал возится с массивами, потянет и так):  
 
Sub tt()  
Dim a(), i&, t(1 To 5), xyxy, x3, x4, x5, x6, xxxx, x8, x9, x10, x11  
a = [a1].CurrentRegion.Value
For i = 1 To UBound(a)  
t(1) = Mid(a(i, 1), 6, 1)  
t(2) = Mid(a(i, 1), 7, 1)  
t(3) = Mid(a(i, 1), 8, 1)  
t(4) = Mid(a(i, 1), 9, 1)  
t(5) = Mid(a(i, 1), 10, 1)  
 
Select Case True  
Case t(2) = t(3) And t(3) = t(4) And t(4) = t(5): xxxx = xxxx + 1: Sheets("xxxx").Cells(xxxx, 1) = a(i, 1)  
Case t(2) = t(4) And t(3) = t(5): xyxy = xyxy + 1: Sheets("xyxy").Cells(xyxy, 1) = a(i, 1)  
 
End Select  
 
Next  
 
End Sub  
 
 
 
Дальше делать надоело, рутина...

Прописать следующие условия в Case и вывод в соотв. листы.  
Для удобства можно заменить имена переменных x3 например на xxyy (1234 нельзя, лучше на abcd, а VIP можно и так написать).  
Только соблюдайте "виповость" - т.е. первым должен выполняться более важный отбор. Чтоб номер 777777 не попал в группу xyxy :)  
Можно в начале кода добавить предварительную очистку всех листов (кроме первого), чтоб там мусор какой не остался от предудущих работ.

{quote}{login=Hugo}{date=02.02.2012 06:21}{thema=}{post}Следующий шаг (не стал возится с массивами, потянет и так):...  
Дальше делать надоело, рутина...{/post}{/quote}  
Off Простите, Hugo, вы не интересовались расценками на "козырные" номера для авто-, мото-, теле-, фото- и пррррр?.. И если, скажем, с продажи каждого такого цифросочетания иметь соответствующий прОцент, то, наверное, имела бы место быть ваша соответствующая заинтересованность?.. Вот только ТС - MonoMonkey - куда-то запропастился/лась, как бы  он/а на это посмотрел/а?.. Или пирог дошел и ... можно линять по-аглицки?.. ;)

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

{quote}{login=Z}{date=02.02.2012 07:40}{thema=Re: }{post}{quote}{login=Hugo}{date=02.02.2012 06:21}{thema=}{post}Следующий шаг (не стал возится с массивами, потянет и так):...  
Дальше делать надоело, рутина...{/post}{/quote}  
Off Простите, Hugo, вы не интересовались расценками на "козырные" номера для авто-, мото-, теле-, фото- и пррррр?.. И если, скажем, с продажи каждого такого цифросочетания иметь соответствующий прОцент, то, наверное, имела бы место быть ваша соответствующая заинтересованность?.. Вот только ТС - MonoMonkey - куда-то запропастился/лась, как бы  он/а на это посмотрел/а?.. Или пирог дошел и ... можно линять по-аглицки?.. ;){/post}{/quote}  
Ну в общем в правильном направлении мысль - рутину за просто так делать неохота.  
То, что было интересно мне и трудно ТС - я вроде сделал (и не только я , MCH  
тоже), дальше пусть работает тот, кто за это деньги получает - там уже ничего сложного.