Доброй ночи, как написать так, чтобы при пробегании по значениям из первой колонки, когда значение меняется, по нему происходила фильтрация и так далее до последнего уникального значения. Не могу решить, как написать, если одно значение не равно другому, то фильтр по этому новому значению. Подскажите, пожалуйста, как это сделать.
Пример приложил. В модуле код.
Доброй ночи, как написать так, чтобы при пробегании по значениям из первой колонки, когда значение меняется, по нему происходила фильтрация и так далее до последнего уникального значения. Не могу решить, как написать, если одно значение не равно другому, то фильтр по этому новому значению. Подскажите, пожалуйста, как это сделать.
Ура... написал... Получается так, но не могу прописать до 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
Ура... написал... Получается так, но не могу прописать до last row чтобы.... а не по конкретному диапазону Подскажите, пожалуйста, как фильтроваться до lr...ant6729
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
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
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]
Не, чуть не так, сравните: [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
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
