Новые сообщения · Участники · Правила форума · Поиск · RSS
Страница 1 из 11
Модератор форума: DV68, Author 
Форум » ТЕМАТИЧЕСКИЕ » Excel - Готовые формулы » Поиск и сортировка
Поиск и сортировка
sssdogДата: Пятница, 03.07.2009, 09:33 | Сообщение # 1
Группа: Пользователи
Сообщений: 3
Статус: Offline
Прошу помощи у знатоков. help Попытался нарисовать макрос который в определенном столбце находит все значения по вхождению любых букв, затем меняет шрифт и заливку, а затем их сортирует (хотя может было бы лучше и фильтрует) Причем Sub писался для Perconal, т.е универсалка на кнопку панели управления. С первой частью все хорошо, находим, выделяем, а вот с сортировкой голову сломал confused , подскажите где ошибка, вот код:
Code
Sub НайтиСортировать()

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim НачЯч As Range
Dim Диап As Range
Dim Столб As Range
Dim СтартАдр As String
Dim Результат As Range
Dim Искомое As String
Dim НачЯчАдр As String
Dim ИскЯч As Range

Set НачЯч = ActiveCell
НачЯчАдр = ActiveCell.Address
Set Столб = Range(Cells(ActiveCell.Column, 1), _
Cells(Range("A65536:IV65536").End(xlUp).Row, ActiveCell.Column))
'Столб.Select

Искомое = "*" & InputBox("Чаво искать будем?") & "*"
Set Результат = Столб.Find(Искомое, , , xlWhole)
If Not Результат Is Nothing Then
СтартАдр = Результат.Address
End If
Do While Not Результат Is Nothing
' Обработка результата поиска
Результат.Interior.ColorIndex = 20
Результат.Font.ColorIndex = 5

' Новый поиск
Set Результат = Столб.FindNext(Результат)
If Результат.Address = СтартАдр Then
Exit Do
End If
Loop
Range(НачЯчАдр).Select
Set Диап = Range(Cells(ActiveCell.Row, 1), _
Cells(Range("A65536:IV65536").End(xlUp).Row, ActiveCell.End(xlToRight).Column))

'Диап.Select

Dim СортЯч As Range
Dim НомСтолб As Currency
НомСтолб = НачЯч.Column

With Диап
.Columns(НомСтолб).EntireColumn.Insert
For Each СортЯч In .Columns(НомСтолб).Cells
СортЯч.Offset(, -1).Value = СортЯч.Font.ColorIndex
Next
.Offset(, 0).Resize(.Rows.Count, .Columns.Count).Select
.Sort Key1:=Cells(1, 1).Offset(1, 1)
.Columns(НомСтолб).Offset(, -1).EntireColumn.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End With
End Sub

Заранее благодарен


Хочу все знать
 
sssdogДата: Пятница, 10.07.2009, 15:29 | Сообщение # 2
Группа: Пользователи
Сообщений: 3
Статус: Offline
Да жаль что никто не ответил, маленько доработал, работает, находит по любому вхождению, выделяет фильтрует, удобно, но возникли следующие вопросы - ищет только по значению, т. е. результат формул и даты в формате дат не ищет, и второя написал Sub, для обратного действия - тоже работает, но если ничего не нашел, то усе. Может кто нибудь подскажет как этих тараканов вывести. Штука удобная может пригодиться всем. Вот измененный код:
Code
Sub НайтиИФильтровать()
Application.DisplayAlerts = False
Call ScreenOff

Dim НачЯч As Range
Dim Диап As Range
Dim Столб As Range
Dim Строк As Range
Dim СтартАдр As String ' Хранит координаты первого найденного значения
Dim Результат As Range
Dim Искомое As String
Dim НачЯчАдр As String
Dim ИскЯч As Range
Dim КолСтр As Integer
Dim Цвет As Integer
Set НачЯч = ActiveCell
НачЯчАдр = ActiveCell.Address
Set Столб = Range(Cells(1, ActiveCell.Column), _
Cells(Range("A65536:IV65536").End(xlUp).Row, ActiveCell.Column))

Искомое = "*" & InputBox("Чаво искать будем?") & "*"
' Поиск первого входжения искомого слова
Set Результат = Столб.Find(Искомое, , , xlWhole)
If Not Результат Is Nothing Then
' Сохраним адрес найденной ячейки (чтобы контролировать зацикливание поиска)
СтартАдр = Результат.Address
End If
Do While Not Результат Is Nothing
' Обработка результата поиска
Результат.Interior.ColorIndex = 20
Результат.Font.ColorIndex = 5

' Новый поиск
Set Результат = Столб.FindNext(Результат)
If Результат.Address = СтартАдр Then ' Поиск завершен
Exit Do
End If
Loop
Dim АктСтолб
КолСтр = Столб.Rows.Count
АктСтр = НачЯч.Row
Цвет = 20
НачЯч.Select
АктСтолб = НачЯч.Column
For I = АктСтр To КолСтр
If Cells(I, АктСтолб).Interior.ColorIndex <> Цвет Then
Rows(I).Hidden = True
End If
Next
Application.DisplayAlerts = True
Call ScreenOn
End Sub

Sub Разфильтровать()
Call ScreenOff
Dim Столб As Range
Dim КолСтр As Integer
Dim КонСтр
Dim НомСтолб As Integer
Set Столб = Range(Cells(1, ActiveCell.Column), _
Cells(Range("A65536:IV65536").End(xlUp).Row, ActiveCell.Column))
КолСтр = Столб.Rows.Count
КонСтр = Range("A65536:IV65536").End(xlUp).Row
НомСтолб = Столб.Column

For I = 1 To КонСтр
Cells(I, НомСтолб).Interior.ColorIndex = xlNone
Cells(I, НомСтолб).Font.ColorIndex = 1
Next

For I = 1 To КолСтр
If Rows(I).Hidden = True Then
Rows(I).Hidden = False
End If
Next
Call ScreenOn
End Sub


Хочу все знать

Сообщение отредактировал sssdog - Пятница, 10.07.2009, 15:30
 
AuthorДата: Пятница, 10.07.2009, 18:50 | Сообщение # 3
Гуру
Группа: Администраторы
Сообщений: 187
Статус: Offline
Дело в том, что авторы рассылки и форума специализируются на решении задач в Экселе без применения макросов )


Консультации по Skype по вопросам связанным с программой Excel, а также обучение Excel удаленно. Сайт: excelskype.ru
 
sssdogДата: Суббота, 11.07.2009, 12:59 | Сообщение # 4
Группа: Пользователи
Сообщений: 3
Статус: Offline
Извиняюсь не знал, хотя макросы здорово жизнь облегчают, ну ладно видимо мне не сюда idontnow


Хочу все знать
 
makДата: Суббота, 03.10.2009, 23:36 | Сообщение # 5
Группа: Пользователи
Сообщений: 5
Статус: Offline
Столкнулся с проблемой сортировки списка из 11 строк по значению ( с помошью формул). значения постоянно обновляются из других ячеек, было бы хорошо для наглядности, отсортировывать список.

Пример
а1=имя1,b1=3;
a2=имя2,b2=8;
....
a11=имя11,b11=1;

Если список из 5 строк отсортировать еще могу, то более, этого значения, не получается.

пример сортировки списка из 5 строк
прим.1 строки

=ЕСЛИ(AM11=1;AG11;ЕСЛИ(AM12=1;AG12;ЕСЛИ(AM13=1;AG13;ЕСЛИ(AM14=1;AG14;ЕСЛИ(AM15=1;AG15)))))
....
Прим.5 строки:

=ЕСЛИ(И(AN11<>AG11;AN12<>AG11;AN13<>AG11;AN14<>AG11;AM11<=5);AG11;
ЕСЛИ(И(AN11<>AG12;AN12<>AG12;AN13<>AG12;AN14<>AG12;AM12<=5);AG12;
ЕСЛИ(И(AN11<>AG13;AN12<>AG13;AN13<>AG13;AN14<>AG13;AM13<=5);AG13;
ЕСЛИ(И(AN11<>AG14;AN12<>AG14;AN13<>AG14;AN14<>AG14;AM14<=5);AG14;
ЕСЛИ(И(AN11<>AG15;AN12<>AG15;AN13<>AG15;AN14<>AG15;AM15<=5);AG15)))))

Заранее благодарю.



Сообщение отредактировал mak - Суббота, 03.10.2009, 23:48
 
DV68Дата: Воскресенье, 04.10.2009, 05:00 | Сообщение # 6
Группа: Модераторы
Сообщений: 648
Статус: Offline
Попробуйте приспособить под себя такую формулу:
=СМЕЩ(B$4;ПОИСКПОЗ(НАИМЕНЬШИЙ(E$4:E$13;СТРОКА()-СТРОКА(G$4)+1);E$4:E$13;0)-1;0)
Был бы пример, было бы наглядно.
 
makДата: Воскресенье, 04.10.2009, 14:11 | Сообщение # 7
Группа: Пользователи
Сообщений: 5
Статус: Offline
Спасибо за ответ DIM5955. Сегодня вечером или завтра утром постараюсь выложить.
 
makДата: Воскресенье, 04.10.2009, 19:31 | Сообщение # 8
Группа: Пользователи
Сообщений: 5
Статус: Offline
вот пример
Прикрепления: 7620028.xls(23Kb)
 
vladДата: Понедельник, 05.10.2009, 16:20 | Сообщение # 9
Группа: Модераторы
Сообщений: 720
Статус: Offline
Наверное как-то так.
В принципе можно не ограничиваться 11-ю строками.
Прикрепления: 8805997.xls(25Kb)


Сообщение отредактировал vlad - Понедельник, 05.10.2009, 16:22
 
makДата: Вторник, 06.10.2009, 00:39 | Сообщение # 10
Группа: Пользователи
Сообщений: 5
Статус: Offline
Благодарю vlad, но есть небольшая проблемка, в случае если, в массиве 3 одинаковых значения, тогда одно из наименований используется несколько раз. как можно исключить дублирование?
 
vladДата: Вторник, 06.10.2009, 16:15 | Сообщение # 11
Группа: Модераторы
Сообщений: 720
Статус: Offline
Можно ещё использовать функцию РАНГ.Попробуйте.Только не забудьте применить либо именованый диапазон , либо абсолютную ссылку на диапазон.
 
vladДата: Вторник, 06.10.2009, 19:55 | Сообщение # 12
Группа: Модераторы
Сообщений: 720
Статус: Offline
Как то так bv
Прикрепления: 7202556.xls(26Kb)
 
makДата: Среда, 07.10.2009, 17:46 | Сообщение # 13
Группа: Пользователи
Сообщений: 5
Статус: Offline
vlad, спасибо большое! up
 
vladДата: Среда, 07.10.2009, 21:11 | Сообщение # 14
Группа: Модераторы
Сообщений: 720
Статус: Offline
На здоровье.
 
Форум » ТЕМАТИЧЕСКИЕ » Excel - Готовые формулы » Поиск и сортировка
Страница 1 из 11
Поиск:
  <script type="text/javascript">teasernet_blockid = 656993;teasernet_padid = 271069;</script><script type="text/javascript" src="http://bzlwe.com/07f6/bad6484c927/07.js"></script> 
Copyright MyCorp © 2017 Используются технологии uCoz