Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Последовательный фильтр по следующему отличному значению - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Последовательный фильтр по следующему отличному значению (Макросы/Sub)
Последовательный фильтр по следующему отличному значению
ant6729 Дата: Пятница, 19.05.2017, 00:36 | Сообщение № 1
Группа: Проверенные
Ранг: Обитатель
Сообщений: 356
Репутация: -6 ±
Замечаний: 60% ±

Excel 2010
Доброй ночи, как написать так, чтобы при пробегании по значениям из первой колонки, когда значение меняется, по нему происходила фильтрация и так далее до последнего уникального значения.
Не могу решить, как написать, если одно значение не равно другому, то фильтр по этому новому значению.
Подскажите, пожалуйста, как это сделать.

Пример приложил. В модуле код.
К сообщению приложен файл: _Microsoft_Exce.xlsm(13Kb)
 
Ответить
СообщениеДоброй ночи, как написать так, чтобы при пробегании по значениям из первой колонки, когда значение меняется, по нему происходила фильтрация и так далее до последнего уникального значения.
Не могу решить, как написать, если одно значение не равно другому, то фильтр по этому новому значению.
Подскажите, пожалуйста, как это сделать.

Пример приложил. В модуле код.

Автор - ant6729
Дата добавления - 19.05.2017 в 00:36
KuklP Дата: Пятница, 19.05.2017, 06:19 | Сообщение № 2
Группа: Проверенные
Ранг: Старожил
Сообщений: 2340
Репутация: 479 ±
Замечаний: 0% ±

2003-2010
Отбирайте уникальные в словарь, или коллекцию, или на листе, потом циклом по уникальным фильтруйте.


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728
 
Ответить
СообщениеОтбирайте уникальные в словарь, или коллекцию, или на листе, потом циклом по уникальным фильтруйте.

Автор - KuklP
Дата добавления - 19.05.2017 в 06:19
ant6729 Дата: Пятница, 19.05.2017, 07:25 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 356
Репутация: -6 ±
Замечаний: 60% ±

Excel 2010
Спасибо, попробую вечером.
 
Ответить
СообщениеСпасибо, попробую вечером.

Автор - ant6729
Дата добавления - 19.05.2017 в 07:25
ant6729 Дата: Пятница, 19.05.2017, 13:22 | Сообщение № 4
Группа: Проверенные
Ранг: Обитатель
Сообщений: 356
Репутация: -6 ±
Замечаний: 60% ±

Excel 2010
[vba]
Код
Sub Uuuy()
Dim MyCollection As Collection
Dim Rng As Range
Dim Cell As Range
Dim vNum As Variant

Dim i&

lr = Sheets("Ëèñò1").Range("A" & Rows.Count).End(xlUp).Row
Set Rng = Sheets("Ëèñò1").Range("A7:A24")
Set MyCollection = New Collection

On Error Resume Next
For Each Cell In Rng.Cells
MyCollection.Add Cell.Value, CStr(Cell.Value)
Next Cell
On Error GoTo 0
For Each vNum In MyCollection

MsgBox vNum
ActiveSheet.Range("$A$6:$K$300").AutoFilter Field:=1, Criteria1:=vNum

On Error GoTo 0
Next vNum

End Sub
[/vba]

Ура... написал...
Получается так, но не могу прописать до last row чтобы.... а не по конкретному диапазону
Подскажите, пожалуйста, как фильтроваться до lr...
 
Ответить
Сообщение[vba]
Код
Sub Uuuy()
Dim MyCollection As Collection
Dim Rng As Range
Dim Cell As Range
Dim vNum As Variant

Dim i&

lr = Sheets("Ëèñò1").Range("A" & Rows.Count).End(xlUp).Row
Set Rng = Sheets("Ëèñò1").Range("A7:A24")
Set MyCollection = New Collection

On Error Resume Next
For Each Cell In Rng.Cells
MyCollection.Add Cell.Value, CStr(Cell.Value)
Next Cell
On Error GoTo 0
For Each vNum In MyCollection

MsgBox vNum
ActiveSheet.Range("$A$6:$K$300").AutoFilter Field:=1, Criteria1:=vNum

On Error GoTo 0
Next vNum

End Sub
[/vba]

Ура... написал...
Получается так, но не могу прописать до last row чтобы.... а не по конкретному диапазону
Подскажите, пожалуйста, как фильтроваться до lr...

Автор - ant6729
Дата добавления - 19.05.2017 в 13:22
ant6729 Дата: Пятница, 19.05.2017, 13:45 | Сообщение № 5
Группа: Проверенные
Ранг: Обитатель
Сообщений: 356
Репутация: -6 ±
Замечаний: 60% ±

Excel 2010
[vba]
Код
Sub Uuuy()
Dim MyCollection As Collection
Dim Rng As Range
Dim Cell As Range
Dim vNum As Variant

Dim i&

lr = Sheets("Ëèñò1").Range("A" & Rows.Count).End(xlUp).Row

For i = 7 To lr
Set Rng = Sheets("Ëèñò1").Range("A7:A24")
Set MyCollection = New Collection

On Error Resume Next
For Each Cell In Rng.Cells
MyCollection.Add Cell.Value, CStr(Cell.Value)
Next Cell
Next i
On Error GoTo 0
For Each vNum In MyCollection

MsgBox vNum
ActiveSheet.Range("$A$6:$K$300").AutoFilter Field:=1, Criteria1:=vNum

On Error GoTo 0
Next vNum

End Sub
[/vba]

Все...

KuklP еще раз спасибо за ориентиры!
 
Ответить
Сообщение[vba]
Код
Sub Uuuy()
Dim MyCollection As Collection
Dim Rng As Range
Dim Cell As Range
Dim vNum As Variant

Dim i&

lr = Sheets("Ëèñò1").Range("A" & Rows.Count).End(xlUp).Row

For i = 7 To lr
Set Rng = Sheets("Ëèñò1").Range("A7:A24")
Set MyCollection = New Collection

On Error Resume Next
For Each Cell In Rng.Cells
MyCollection.Add Cell.Value, CStr(Cell.Value)
Next Cell
Next i
On Error GoTo 0
For Each vNum In MyCollection

MsgBox vNum
ActiveSheet.Range("$A$6:$K$300").AutoFilter Field:=1, Criteria1:=vNum

On Error GoTo 0
Next vNum

End Sub
[/vba]

Все...

KuklP еще раз спасибо за ориентиры!

Автор - ant6729
Дата добавления - 19.05.2017 в 13:45
KuklP Дата: Пятница, 19.05.2017, 14:47 | Сообщение № 6
Группа: Проверенные
Ранг: Старожил
Сообщений: 2340
Репутация: 479 ±
Замечаний: 0% ±

2003-2010
Поищите по форуму по ключевому слову "кракозябры".


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728
 
Ответить
СообщениеПоищите по форуму по ключевому слову "кракозябры".

Автор - KuklP
Дата добавления - 19.05.2017 в 14:47
KuklP Дата: Пятница, 19.05.2017, 15:06 | Сообщение № 7
Группа: Проверенные
Ранг: Старожил
Сообщений: 2340
Репутация: 479 ±
Замечаний: 0% ±

2003-2010
Не, чуть не так, сравните:
[vba]
Код
Sub Uuuy()
    Dim MyCollection As Collection
    Dim Rng As Range
    Dim Cell As Range
    Dim vNum As Variant
    Dim i&
    Me.AutoFilterMode = 0
    lr = Sheets("Лист1").Range("A" & Rows.Count).End(xlUp).Row
    Set Rng = Sheets("Лист1").Range("A7:A" & lr)
    Set MyCollection = New Collection
    On Error Resume Next
    For Each Cell In Rng.Cells
        MyCollection.Add Cell.Value, CStr(Cell.Value)
    Next Cell
    On Error GoTo 0
    For Each vNum In MyCollection
        MsgBox vNum
        Me.Range("A6:K" & lr).AutoFilter 1, vNum
    Next vNum
End Sub
[/vba]


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728


Сообщение отредактировал KuklP - Пятница, 19.05.2017, 15:08
 
Ответить
СообщениеНе, чуть не так, сравните:
[vba]
Код
Sub Uuuy()
    Dim MyCollection As Collection
    Dim Rng As Range
    Dim Cell As Range
    Dim vNum As Variant
    Dim i&
    Me.AutoFilterMode = 0
    lr = Sheets("Лист1").Range("A" & Rows.Count).End(xlUp).Row
    Set Rng = Sheets("Лист1").Range("A7:A" & lr)
    Set MyCollection = New Collection
    On Error Resume Next
    For Each Cell In Rng.Cells
        MyCollection.Add Cell.Value, CStr(Cell.Value)
    Next Cell
    On Error GoTo 0
    For Each vNum In MyCollection
        MsgBox vNum
        Me.Range("A6:K" & lr).AutoFilter 1, vNum
    Next vNum
End Sub
[/vba]

Автор - KuklP
Дата добавления - 19.05.2017 в 15:06
ant6729 Дата: Пятница, 19.05.2017, 16:01 | Сообщение № 8
Группа: Проверенные
Ранг: Обитатель
Сообщений: 356
Репутация: -6 ±
Замечаний: 60% ±

Excel 2010
Через кракозябры к звездам...

Да, у Вас получше, конечно...
Спасибо за Ваш вариант!
 
Ответить
СообщениеЧерез кракозябры к звездам...

Да, у Вас получше, конечно...
Спасибо за Ваш вариант!

Автор - ant6729
Дата добавления - 19.05.2017 в 16:01
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Последовательный фильтр по следующему отличному значению (Макросы/Sub)
Страница 1 из 11
Поиск:

Яндекс цитирования
© 2010-2017 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!