Автофильтр / Microsoft Office

ReSQL.ru

Мобильная версия Контакт Правила FAQ Помощь

Гость

Войти | Регистрация | Профиль | Очистить

Новые сообщения | Избранное

Форумы | Пользователи | Статистика | Мод. лог | Поиск

Цитировать

Написать

Автор*:

Ввести пароль для входа

Тема*:

Сообщение

Данное сообщение тематическое

Сообщение содержит картинки или видео 18+

Автор:

ВНИМАНИЕ! На данном подфоруме действуют строгие правила. Удостоверьтесь, что ваше сообщение соответствует им!

Форум или тема закрыты для гостей. Необходима авторизация!

Загрузить последнюю сохраненную версию

Вложение:

Вставить как галерею

Максимальный размер вложений: 4,0 МБ, аудио/видео: 8,0 МБ. Картинки большего размера ужимаются, если возможно.

Введите код, изображенный на картинке. Если код нечитаемый, кликните картинку, чтобы загрузить другой вариант.

Отправляя сообщение, я выражаю свое согласие с правилами форума и принимаю пользовательское соглашение.

Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр

Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Автофильтр

25 сообщений из 51, страница 1 из 3

все

Автофильтр

#34806269

nPUBET

Гость

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.

Sub FilTR()
Worksheets("K1").Activate

With ActiveSheet
            .AutoFilterMode = False
                With .Range("a1:bb1")
                    .AutoFilter
                     .AutoFilter Field:= 10 , Criteria1:="T?2"
                    
                     .AutoFilter Field:= 3 , Criteria1:="C?????-K", _
                     Operator:=xlAnd, Criteria2:="C?????-A"
                End With
    End With
End Sub

Фильтрую по 2 колонкам, причём в 3-ем столбце применяю одновременно 2 критерия. Алгоритм не работает, однако если использовать 1 критерий (в 3-ем столбце) и 1 критерий в 10-ом столбце, то всё в порядке.

Подскажите, пожалуйста, где я ошибся.

...

Рейтинг:

0 / 0

17.09.2007, 19:29:41

| Ответить | Цитировать | Написать

Автофильтр

#34806548

lena_###

Гость

nPUBET

Вместо

Код: plaintext

Operator:=xlAnd

попробуйте

Код: plaintext

Operator:=xlOr

...

Рейтинг:

0 / 0

17.09.2007, 23:28:18

| Ответить | Цитировать | Написать

Автофильтр

#34807233

nPUBET

Гость

lena_###
Вместо

Код: plaintext

Operator:=xlAnd

попробуйте

Код: plaintext

Operator:=xlOr

lena_###

Спасибо.
Получилось.

...

Рейтинг:

0 / 0

18.09.2007, 11:10:10

| Ответить | Цитировать | Написать

Автофильтр

#34807791

nPUBET

Гость

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.

Sub OTRIC()
Worksheets("K1").Activate

    Const List1 = "K1"
     Dim i As Integer
     Dim otricatel As Integer  '********
    Dim mList( 2 ) As String
    Dim dr As Integer
    Dim xlSh1 As Worksheet, rng As Range
    mList( 0 ) = "No."
    dr = ActiveSheet.UsedRange.Rows.Count
    Set xlSh1 = Worksheets(List1)
'** здесь фильтрую таблицу по 3-ему и 10-ому столбцам
      
    For i =  0  To UBound(mList)  'перехожу в столбец "No."
        Set rng = xlSh1.Range("1:1").Find(mList(i), xlSh1.Range("A1"), LookIn:=xlFormulas, LookAt:= _
            xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
        If Not rng Is Nothing Then
'        rng.Cells(dr, "1").Interior.ColorIndex = 37
        xlSh1.Cells(dr,  1 ).Interior.ColorIndex =  37 

'
'                    For otricatel = 1 To dr
'
''
'                    Next otricatel
            
        Else
            MsgBox "ne najden stolbec " & Chr$( 34 ) & mList(i) & Chr$( 34 )
        End If
    Next
    Application.CutCopyMode = False
    MsgBox "Stolbec " & Chr$( 34 ) & mList( 0 ) & Chr$( 34 ) & " najden"

End Sub

С этим макросом ищу столбец с названием "No."
Дальше не смог сформулировать.

Пытаюсь сделать следующее:
- в цикле

Код: plaintext

For otricatel =  1  To dr...Next otricatel

ищу в столбце "No." одинаковые значения в абсолютном выражении, т.е. например "1204,3" и "-1204,3". Далее перехожу в строку с отрицательным значением, т.е. "-1204,3" и удаляю строку целиком.
Подскажите, пожалуйста, как это сделать?

...

Рейтинг:

0 / 0

18.09.2007, 13:15:36

| Ответить | Цитировать | Написать

Автофильтр

#34808667

vkodor

Участник

Откуда: Moscow

Сообщения: 1 809

Рейтинг: 0 / 0

Нужен другой алгоритм.
Предлагаю так.
Организовываем доп. столбец (в примере - "M") в который вставляем формулу "ABS", дальше делаем сортировку по доп. столбцу и столбцу "K" ("No.") после этого устанавливаем фильтр и делаем пробег по отфильтрованным строкам с проверкой, на раменство, предыдущей ячейки с последующей и если они равны накапливаем в массив, а после пробега удаляем. А затем очищаем доп. столбец. Мда...
Вообщем разберись с кодом.

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.

Private Sub OTRIC()

    Dim i As Integer, fil As Filter, xlSh1 As Worksheet, rng As Range, rng2 As Range, rng3 As Range
    
    
    Set xlSh1 = ActiveSheet
    With xlSh1
        If .AutoFilterMode Then 'проверка стоит ли фильтр
            For Each fil In .AutoFilter.Filters
                If fil.On Then .ShowAllData: Exit For 'проверка стоит ли критерий
            Next
        Else
            .Range(.Cells( 1 ,  1 ), .Cells( 1 , .UsedRange.Columns.Count +  1 )).AutoFilter 'включение автофильтра
        End If
        ' вставка формулы (по модулю) в доп столбец
        .Range(.Cells( 2 ,  13 ), .Cells(.Cells(Rows.Count,  11 ).End(xlUp).Row,  13 )).FormulaR1C1 = "=ABS(RC[-2])"
        'сортировка по доп столбцу и столбцу "No."
        .Range(.Cells( 2 ,  1 ), .Cells(.Cells(Rows.Count,  13 ).End(xlUp).Row,  15 )).Sort Key1:=.Range("M2"), Order1:=xlAscending, Key2:=.Range("K2") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:= 1 , MatchCase:= _
        False, Orientation:=xlTopToBottom
        ' выставляем фильтр
        .Range("A1").AutoFilter Field:= 10 , Criteria1:="T?2"
        .Range("A1").AutoFilter Field:= 3 , Criteria1:="C?????-K", _
            Operator:=xlOr, Criteria2:="C?????-A"

        'отбираем отфильтрованные строки
        Debug.Print
        Set rng = .Range("M2:M" & .Cells(Rows.Count,  11 ).End(xlUp).Row).SpecialCells(xlCellTypeVisible)
        'пробег по отфильтрованным строкам
        For Each rng2 In rng
            If rng2 = rng2.Offset( 1 ,  0 ) Then
                If rng2.Offset( 0 , - 2 ) <  0  Then
                    If rng3 Is Nothing Then
                        Set rng3 = rng2
                    Else
                        Set rng3 = Union(rng3, rng2)
                    End If
                End If
            End If
        Next
        If Not rng3 Is Nothing Then rng3.EntireRow.Delete
        .Range("M:M").ClearContents
    End With
End Sub

P.S. столбец "No." д.б. в "К"

...

Рейтинг:

0 / 0

18.09.2007, 16:17:52

| Ответить | Цитировать | Написать

Автофильтр

#34808914

nPUBET

Гость

vkodor
Спасибо за алгоритм!

...извиняюсь, я немного не так обьяснил...
1. Сортирую.
2. Перехожу в 3-й столбец ("Участок").
3. Ищу в этом столбце одинаковые номера по следуюшему критерию

Код: plaintext

       .AutoFilter Field:= 3 , Criteria1:="=*?????-A*", _
                     Operator:=xlOr, Criteria2:="=*?????-K*"

4. Образую области обработки для каждого номера по критерию отдельно (на рисунке они - разными цветами).
- т.е. с 2-ой по 9-ю строки - это номера, которые подходят под номер "C10001-А*" (см. рис.)
- с 10-ой по 15-ю строки - "E10399-K*"
- с 16-ой по 45-ю строки - "C10145-A*"

5. Если номер в 3-ем столбце нижней строки не подходит по критерию, перехожу в 11-ый столбец (т.е. иду с 9 строки 3-го столбца во 2-ю строку 11-го столбца - т.к. область обработки для "C10001-А*" находится в промежутке с 2-ой по 9-ую строки).

6. Здесь (т.е. только для "C10001-А*") ищу одинаковые значения в абсолютном выражении.
7. Eсли сумма 2-х значений (одинаковых в абсолюте) равна нулю (в суммировании участвуют только две ячейки), то строки с этими значениями удаляю.

В итоге, если всё просчитаю, от строк на рисунке останется только две.

...

Рейтинг:

0 / 0

18.09.2007, 17:05:40

| Ответить | Цитировать | Написать

Автофильтр

#34808924

nPUBET

Гость

Вот файл.

...

Рейтинг:

0 / 0

18.09.2007, 17:07:08

| Ответить | Цитировать | Написать

Автофильтр

#34808973

vkodor

Участник

Откуда: Moscow

Сообщения: 1 809

Рейтинг: 0 / 0

Помойму то что я написал подойдет, только удаление надо подправить

Код: plaintext

1.
2.
3.
4.
5.
6.

    If rng3 Is Nothing Then
        Set rng3 = rng2
        Set rng3 = Union(rng3, rng2.Offset( 1 ,  0 ))
    Else
        Set rng3 = Union(rng3, rng2)
        Set rng3 = Union(rng3, rng2.Offset( 1 ,  0 ))
    End If

...

Рейтинг:

0 / 0

18.09.2007, 17:18:42

| Ответить | Цитировать | Написать

Автофильтр

#34809057

vkodor

Участник

Откуда: Moscow

Сообщения: 1 809

Рейтинг: 0 / 0

работает только критерий надо подправить

Код: plaintext

        .Range("A1").AutoFilter Field:= 3 , Criteria1:="*?????-K**", _
            Operator:=xlOr, Criteria2:="=*?????-A**"

...

Рейтинг:

0 / 0

18.09.2007, 17:39:15

| Ответить | Цитировать | Написать

Автофильтр

#34809116

nPUBET

Гость

Спасибо!

Изучаю...

...

Рейтинг:

0 / 0

18.09.2007, 17:50:34

| Ответить | Цитировать | Написать

Автофильтр

#34809343

nPUBET

Гость

...у меня такой pезультат: остается 3 строки (см. рис.).

Я многое в VBA пока не понимаю.
Объясни, пожалуйста, что выполняется в отдельных строках Твоего алгоритма (выделил по частям).

1 Часть:

Код: plaintext

1.
2.
3.
4.
5.

  If .AutoFilterMode Then '
            For Each fil In .AutoFilter.Filters
                If fil.On Then .ShowAllData: Exit For '
            Next
....
        End If

2 Часть:

Код: plaintext

1.
2.
3.

 .Range(.Cells( 2 ,  13 ), .Cells(.Cells(Rows.Count,  11 ).End(xlUp).Row,  13 )).FormulaR1C1 = "=ABS(RC[-2])"
         .Range(.Cells( 2 ,  1 ), .Cells(.Cells(Rows.Count,  13 ).End(xlUp).Row,  15 )).Sort Key1:=.Range("M2"), Order1:=xlAscending, Key2:=.Range("K2") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:= 1 , MatchCase:= _
        False, Orientation:=xlTopToBottom

3 Часть:

Код: plaintext

1.
2.

Debug.Print
        Set rng = .Range("M2:M" & .Cells(Rows.Count,  11 ).End(xlUp).Row).SpecialCells(xlCellTypeVisible)
        For Each rng2 In rng

4 Часть:

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.

            If rng2 = rng2.Offset( 1 ,  0 ) Then
                If rng2.Offset( 0 , - 2 ) <  0  Then
                '************
                       If rng3 Is Nothing Then
                            Set rng3 = rng2
                            Set rng3 = Union(rng3, rng2.Offset( 1 ,  0 ))
                        Else
                            Set rng3 = Union(rng3, rng2)
                            Set rng3 = Union(rng3, rng2.Offset( 1 ,  0 ))  
                       End If ....

5 Часть:

Код: plaintext

  If Not rng3 Is Nothing Then rng3.EntireRow. ...

...

Рейтинг:

0 / 0

18.09.2007, 18:49:24

| Ответить | Цитировать | Написать

Автофильтр

#34809407

nPUBET

Гость

Файл с тремя строками...

...

Рейтинг:

0 / 0

18.09.2007, 19:09:00

| Ответить | Цитировать | Написать

Автофильтр

#34810925

nPUBET

Гость

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.

Sub FiltP()
Sheets("K1").Activate

Dim iNteg As Integer
Dim fil As Filter
Dim xlSh1 As Worksheet
Dim rng As Range

    Set xlSh1 = ActiveSheet
    With xlSh1
    '********
            If .AutoFilterMode Then
            For Each fil In .AutoFilter.Filters
                If fil.On Then .ShowAllData: Exit For
            Next
        Else
            .Range(.Cells( 1 ,  1 ), .Cells( 1 , .UsedRange.Columns.Count +  1 )).AutoFilter '
        End If
'******???
'    .Range("a1").AutoFilter Field:="No*", Criteria1:="T?2"  'Error1004
'
'    .Range("a1").AutoFilter Field:="PT*", Criteria1:="*?????-A**", Operator:=xlOr, _
'    Criteria2:="*?????-K**"
'******???
    End With
End Sub

фильтрую не по номеру столбца, а по названию столбца. Макрос выдаёт ошибку:
Error 1004 (Autofilter method of Range Class).

Подскажите, пожалуйста, как фильтровать столбцы динамически, т.е. по названию столбца, не используя в "Field:=" числа, а названия столбцов.
Файл с "Еrror 1004" приложил.

...

Рейтинг:

0 / 0

19.09.2007, 12:54:23

| Ответить | Цитировать | Написать

Автофильтр

#34811102

vkodor

Участник

Откуда: Moscow

Сообщения: 1 809

Рейтинг: 0 / 0

1 Часть:

Код: plaintext

1.
2.
3.
4.
5.

  If .AutoFilterMode Then '
            For Each fil In .AutoFilter.Filters
                If fil.On Then .ShowAllData: Exit For '
            Next
....
        End If

If .AutoFilterMode Then - если .AutoFilterMode = True (на листе включен автофильтр) тогда
For Each fil In .AutoFilter.Filters - пробег по всем колонкам фильтра
If fil.On Then .ShowAllData: Exit For - если колонка отфильтрована то снимаем фильтр со всех колонок и выходим из цикла

2 Часть:

Код: plaintext

1.
2.
3.

 .Range(.Cells( 2 ,  13 ), .Cells(.Cells(Rows.Count,  11 ).End(xlUp).Row,  13 )).FormulaR1C1 = "=ABS(RC[-2])"
         .Range(.Cells( 2 ,  1 ), .Cells(.Cells(Rows.Count,  13 ).End(xlUp).Row,  15 )).Sort Key1:=.Range("M2"), Order1:=xlAscending, Key2:=.Range("K2") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:= 1 , MatchCase:= _
        False, Orientation:=xlTopToBottom

.Range(.Cells(2, 13), .Cells(.Cells(Rows.Count, 11).End(xlUp).Row, 13)).FormulaR1C1 = "=ABS(RC[-2])" - вставка в Ячейки начиная с .Cells(2, 13) (вторая строка 13-ый столбец) до .Cells(.Cells(Rows.Count, 11).End(xlUp).Row, 13) (нижняя заполненая строка по 11-му столбцу 13-ый столбец) формулу "=ABS(RC[-2])" возвращающую модуль (абсолютную величину) числа из -2 столбца (т.е. 11-го)
3 Часть:

Код: plaintext

1.
2.

Debug.Print
        Set rng = .Range("M2:M" & .Cells(Rows.Count,  11 ).End(xlUp).Row).SpecialCells(xlCellTypeVisible)
        For Each rng2 In rng

присваиваем переменной "rng" не скрытые (xlCellTypeVisible) ячейки столбца "М"
For Each rng2 In rng - присваиваем поочереди переменной rng2 ячейки из переменной rng

4 Часть:

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.

            If rng2 = rng2.Offset( 1 ,  0 ) Then
                If rng2.Offset( 0 , - 2 ) <  0  Then
                '************
                       If rng3 Is Nothing Then
                            Set rng3 = rng2
                            Set rng3 = Union(rng3, rng2.Offset( 1 ,  0 ))
                        Else
                            Set rng3 = Union(rng3, rng2)
                            Set rng3 = Union(rng3, rng2.Offset( 1 ,  0 ))  
                       End If ....

если выполняются условия, то накапливаем в rng3 нужные ячейки

5 Часть:

Код: plaintext

  If Not rng3 Is Nothing Then rng3.EntireRow. ...

если rng3 не пуста то удаляем строки содержащие ячейки накопленные в rng3

...

Рейтинг:

0 / 0

19.09.2007, 13:30:17

| Ответить | Цитировать | Написать

Автофильтр

#34811220

nPUBET

Гость

vkodor1 Часть:

Код: plaintext

  If .AutoFilterMode Then '
             ...

если rng3 не пуста то удаляем строки содержащие ячейки накопленные в rng3

Спасибо!

...может у Тебя есть идеи по "...Range("a1").AutoFilter Field=.." не по числам?

nPUBET, 19.09, 12:54 cм.

...

Рейтинг:

0 / 0

19.09.2007, 13:52:25

| Ответить | Цитировать | Написать

Автофильтр

#34811752

vkodor

Участник

Откуда: Moscow

Сообщения: 1 809

Рейтинг: 0 / 0

идея только одна, поскольку невозможно в свойстве Field обращаться не по номеру, надо через find искать номер столбца.
примерно так

Код: plaintext

1.
2.
3.

    i = .Range("1:1").Find("PT", LookIn:=xlFormulas, LookAt:= _
        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True).Column
    .Range("a1").AutoFilter Field:=i, Criteria1:="*?????-A**", Operator:=xlOr, _
    Criteria2:="*?????-K**"

...

Рейтинг:

0 / 0

19.09.2007, 15:55:21

| Ответить | Цитировать | Написать

Автофильтр

#34811949

nPUBET

Гость

vkodorидея только одна, поскольку невозможно в свойстве Field обращаться не по номеру, надо через find искать номер столбца.
примерно так

Код: plaintext

1.
2.
3.

    i = .Range("1:1").Find("PT", LookIn:=xlFormulas, LookAt:= _
        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True).Column
    .Range("a1").AutoFilter Field:=i, Criteria1:="*?????-A**", Operator:=xlOr, _
    Criteria2:="*?????-K**"

Спасибо за идею!
Пока у меня выглядит так. Cортирует, но строки не удаляет (думаю, дело в номерах столбцов).
Поэтому cейчас занимаюсь заменой номеров и букв столбцов (11, 13, 15, "M2:M", "K2",...) на iPT.

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.

Sub OTRIC_2()
Sheets("K1").Activate
    Dim i As Integer, fil As Filter, xlSh1 As Worksheet, rng As Range, rng2 As Range, rng3 As Range
        
    Set xlSh1 = ActiveSheet
    With xlSh1
        If .AutoFilterMode Then '
            For Each fil In .AutoFilter.Filters
                If fil.On Then .ShowAllData: Exit For '
            Next
        Else
            .Range(.Cells( 1 ,  1 ), .Cells( 1 , .UsedRange.Columns.Count +  1 )).AutoFilter '
        End If
        
        '************
        Dim iNo As Long
        Dim iPT As Long
        
        iPT = .Range("1:1").Find("PT*", LookIn:=xlFormulas, LookAt:= _
        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True).Column
    .Range("a1").AutoFilter Field:=iPT, Criteria1:="*?????-A**", Operator:=xlOr, _
    Criteria2:="*?????-K**"
    
          iNo = .Range("1:1").Find("AB*", LookIn:=xlFormulas, LookAt:= _
        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True).Column
    .Range("a1").AutoFilter Field:=iNo, Criteria1:="T?2"
    


        '*******************
         .Range(.Cells( 2 ,  13 ), .Cells(.Cells(Rows.Count,  11 ).End(xlUp).Row,  13 )). _ 
         FormulaR1C1 = "=ABS(RC[-2])"
        
        .Range(.Cells( 2 ,  1 ), .Cells(.Cells(Rows.Count,  13 ).End(xlUp).Row,  15 )). _ 
        Sort Key1:=.Range("M2"), Order1:=xlAscending, Key2:=.Range("K2") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:= 1 , MatchCase:= _
        False, Orientation:=xlTopToBottom
        
        '*************
        '
        Debug.Print
        Set rng = .Range("M2:M" & .Cells(Rows.Count,  11 ).End(xlUp).Row). _ 
       SpecialCells(xlCellTypeVisible)
        '
        For Each rng2 In rng
            If rng2 = rng2.Offset( 1 ,  0 ) Then
                If rng2.Offset( 0 , - 2 ) <  0  Then
                    If rng3 Is Nothing Then
                        Set rng3 = rng2
                    Else
                        Set rng3 = Union(rng3, rng2)
                    End If
                End If
            End If
        Next
        If Not rng3 Is Nothing Then rng3.EntireRow.Delete
        .Range("M:M").ClearContents
    End With
End Sub

...

Рейтинг:

0 / 0

19.09.2007, 16:38:54

| Ответить | Цитировать | Написать

Автофильтр

#34812533

nPUBET

Гость

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.

Sub OTRIC_2()
Sheets("K1").Activate
    Dim i As Integer, fil As Filter, xlSh1 As Worksheet, rng As Range, rng2 As Range, rng3 As Range
        
    Set xlSh1 = ActiveSheet
    With xlSh1
        If .AutoFilterMode Then
            For Each fil In .AutoFilter.Filters
                If fil.On Then .ShowAllData: Exit For
            Next
        Else
            .Range(.Cells( 1 ,  1 ), .Cells( 1 , .UsedRange.Columns.Count +  1 )).AutoFilter '
        End If
        
        '************
        Dim iAB As Long
        Dim iPT As Long
        Dim iNo As Long
        
           iNo = .Range("1:1").Find("No*", LookIn:=xlFormulas, LookAt:= _
        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True).Column
        
        iPT = .Range("1:1").Find("PT*", LookIn:=xlFormulas, LookAt:= _
        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True).Column
    .Range("a1").AutoFilter Field:=iPT, Criteria1:="*?????-A**", Operator:=xlOr, _
    Criteria2:="*?????-K**"
    
          iAB = .Range("1:1").Find("AB*", LookIn:=xlFormulas, LookAt:= _
        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True).Column
    .Range("a1").AutoFilter Field:=iAB, Criteria1:="T?2"

        '*******************
         .Range(.Cells( 2 ,  33 ), .Cells(.Cells(Rows.Count, iNo).End(xlUp).Row,  33 )).FormulaR1C1 = "=ABS(RC[-22])"  '*****!!!!!!!
        
        .Range(.Cells( 2 ,  1 ), .Cells(.Cells(Rows.Count,  33 ).End(xlUp).Row,  35 )).Sort Key1:=.Cells( 2 ,  33 ), _
        Order1:=xlAscending, Key2:=.Cells( 2 , iNo) _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:= 1 , MatchCase:= _
        False, Orientation:=xlTopToBottom
        '*************
    End With
End Sub

С =Union= мне трудновато. Удаление решил делать по-другому (позже покажу).
Вычисления =ABS(RC[-22])= делаю в 33-ом столбце (на всякий случай).
Код наверху работает.
А вот вариант строки внизу не проходит.
.Range(.Cells(2, 33), .Cells(.Cells(Rows.Count, iNo).End(xlUp).Row, 33)).FormulaR1C1 = "=ABS(RC[Cells(2,iNo)])"Т.е не могу привязать =ABS(RC[-22])= к переменной =iNo=.
Как связать =ABS(RC[-22])= с переменной =iNo=?

...

Рейтинг:

0 / 0

19.09.2007, 19:05:35

| Ответить | Цитировать | Написать

Автофильтр

#34813191

vkodor

Участник

Откуда: Moscow

Сообщения: 1 809

Рейтинг: 0 / 0

Код: plaintext

.Range(.Cells( 2 ,  33 ), .Cells(.Cells(Rows.Count, iNo).End(xlUp).Row,  33 )).FormulaR1C1 = "=ABS(RC[" & iNo -  33  & "])"

...

Рейтинг:

0 / 0

20.09.2007, 08:45:44

| Ответить | Цитировать | Написать

Автофильтр

#34815852

nPUBET

Гость

vkodor

Код: plaintext

.Range(.Cells( 2 ,  33 ), .Cells(.Cells(Rows.Count, iNo).End(xlUp).Row,  33 )).FormulaR1C1 = "=ABS(RC[" & iNo -  33  & "])"

vkodor
Большое спасибо!

Вот работает...

Код: plaintext

Sub OTRIC_2()
Sheets("K1").Activate
    Dim i As Integer, fil As Filter, xlSh1 As Worksheet, rng As Range, rng2 As Range, rng3 As Range
        
    Set xlSh1 = ActiveSheet
    With xlSh1
        If .AutoFilterMode Then
            For Each fil In .AutoFilter.Filters
                If fil.On Then .ShowAllData: Exit For
            Next
        Else
            .Range(.Cells( 1 ,  1 ), .Cells( 1 , .UsedRange.Columns.Count +  1 )).AutoFilter '
        End If
        
        '************
        Dim iAB As Long
        Dim iPT As Long
        Dim iNo As Long
        
           iNo = .Range("1:1").Find("No*", LookIn:=xlFormulas, LookAt:= _
        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True).Column
        
        iPT = .Range("1:1").Find("PT*", LookIn:=xlFormulas, LookAt:= _
        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True).Column
    .Range("a1").AutoFilter Field:=iPT, Criteria1:="*?????-A**", Operator:=xlOr, _
    Criteria2:="*?????-K**"
    
          iAB = .Range("1:1").Find("AB*", LookIn:=xlFormulas, LookAt:= _
        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True).Column
    .Range("a1").AutoFilter Field:=iAB, Criteria1:="T?2"

        '******************* "=ABS(RC[-22])"
'         .Range(.Cells(2, 33), .Cells(.Cells(Rows.Count, iNo).End(xlUp).Row, 33)).FormulaR1C1 = "=ABS(RC[-22])"
         .Range(.Cells( 2 ,  33 ), .Cells(.Cells(Rows.Count, iNo).End(xlUp).Row,  33 )).FormulaR1C1 = "=ABS(RC[" & iNo -  33  & "])"

         .Range(.Cells( 2 ,  1 ), .Cells(.Cells(Rows.Count,  33 ).End(xlUp).Row,  35 )).Sort Key1:=.Cells( 2 ,  33 ), _
        Order1:=xlAscending, Key2:=.Cells( 2 , iNo) _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:= 1 , MatchCase:= _
        False, Orientation:=xlTopToBottom
        
        '*************
'        Sub Udalenie()

        Dim sK As String
        Dim iK As Long, jK As Long, kLong As Long, konec As Long
            Application.ScreenUpdating = False
            konec = Cells(Rows.Count,  33 ).End(xlUp).Row
            For iK =  2  To konec
                For jK = iK +  1  To konec +  1 
                  If Cells(iK,  33 ).Value = Cells(jK,  33 ).Value Then
                    Cells(iK,  33 ).Interior.ColorIndex =  45 
                    Cells(jK,  33 ).Interior.ColorIndex =  45 
                    Else
                       End If
                Next jK
            Next iK
                    For k = konec To  1  Step - 1 
                        If Cells(k,  33 ).Interior.ColorIndex =  45  Then
                        Cells(k,  33 ).EntireRow.Delete
                      End If
                    Next k
              Range(Cells( 2 ,  33 ), Cells(.Cells(Rows.Count, iNo).End(xlUp).Row,  33 )).ClearContents
        
            Application.ScreenUpdating = True
    
'End Sub
                    

    End With
End Sub

...

Рейтинг:

0 / 0

20.09.2007, 19:17:48

| Ответить | Цитировать | Написать

Автофильтр

#34817253

nPUBET

Гость

Часть верхнего алгоритма =Sub OTRIC_2()=

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.

......
      ....
        '************
        Dim iAB As Long
        Dim iPT As Long
.......
 iAB = .Range("1:1").Find("AB*", LookIn:=xlFormulas, LookAt:= _
        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True).Column
    .Range("a1").AutoFilter Field:=iAB, Criteria1:="T?2"
.....
False, Orientation:=xlTopToBottom
        
'        '*************
'        Sub Udalenie()

        Dim sK As String
        Dim iK As Long, jK As Long, kLong As Long, konec As Long
            Application.ScreenUpdating = False
            konec = Cells(Rows.Count,  43 ).End(xlUp).Row
            '**********
            For Each iAB In ActiveSheet   '********  <<<<<<
            '*********
            For iK =  2  To konec
                For jK = iK +  1  To konec +  1 
                  If Cells(iK,  43 ).Value = Cells(jK,  43 ).Value Then
                    Cells(iK,  43 ).Interior.ColorIndex =  45 
                    Cells(jK,  43 ).Interior.ColorIndex =  45 
                    Else
                       End If
                Next jK
            Next iK
                    For k = konec To  1  Step - 1 
                        If Cells(k,  43 ).Interior.ColorIndex =  45  Then
                        Cells(k,  43 ).EntireRow.Delete
                      End If
                    Next k
                    '*******
            Next  '********  <<<<<
                    '******
              Range(Cells( 2 ,  43 ), Cells(.Cells(Rows.Count, iNo).End(xlUp).Row,  43 )).ClearContents
.....

выдаёт ошибку:"Переменная =iAB= должна иметь тип Variant или Object".
Подскажите, пожалуйста, как активировать =Sub Udalenie()= только для переменных =iAB=?

...

Рейтинг:

0 / 0

21.09.2007, 12:09:38

| Ответить | Цитировать | Написать

Автофильтр

#34817424

nPUBET

Гость

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.

       .....
 False, Orientation:=xlTopToBottom
        
'        '*************
'        Sub Udalenie()

        Dim sK As String
        Dim iK As Long, jK As Long, kLong As Long, konec As Long
            Application.ScreenUpdating = False
            konec = Cells(Rows.Count,  43 ).End(xlUp).Row
'            '**********
'            Dim CellAB As Range
'            For Each Cell In Cells.SpecialCells(xlCellTypeVisible)
            Dim cAB As Object
'            Application.Volatile
'            For Each Cell In cAB
                If Not Rows.Hidden Then
'                    If Not Cells.Hidden Then
            '*********
            For iK =  2  To konec
                For jK = iK +  1  To konec +  1 
                  If Cells(iK,  43 ).Value = Cells(jK,  43 ).Value Then
                    Cells(iK,  43 ).Interior.ColorIndex =  45 
                    Cells(jK,  43 ).Interior.ColorIndex =  45 
                    Else
                       End If
                Next jK
            Next iK
                    For k = konec To  1  Step - 1 
                        If Cells(k,  43 ).Interior.ColorIndex =  45  Then
                        Cells(k,  43 ).EntireRow.ClearContents
                      End If
                    Next k
                    '*******
'                    End If
                End If
'            Next
.....
                    '******

...так тоже не работает.

Подскажите, пожалуйста, как активировать =Sub Udalenie()= только для переменных =iAB=?

...

Рейтинг:

0 / 0

21.09.2007, 12:51:46

| Ответить | Цитировать | Написать

Автофильтр

#34817690

vkodor

Участник

Откуда: Moscow

Сообщения: 1 809

Рейтинг: 0 / 0

nPUBET
выдаёт ошибку:"Переменная =iAB= должна иметь тип Variant или Object".

iAB = .Range("1:1").Find("AB*", LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True).Column

здесь используется метод "find" обьекта "Range" и возвращается номер столбца "Column"
следовательно переменная д.б. long, но если метод "Find" не найдет нужного значения (в данной ситуации "AB*"), то будет вызываться ошибка, поэтому обычно делают так:
объявляют переменную типа range

Код: plaintext

Dim rng3 As Range

затем присваивают ей результат метода find

Код: plaintext

Set rng = .Range("1:1").Find("AB*", xlSh1.Range("A1"), LookIn:=xlFormulas, LookAt:= _
            xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)

и затем проверяют (найдено или нет)

Код: plaintext

        If Not rng Is Nothing Then iAB = rng.Column Else Exit sub

nPUBET
Подскажите, пожалуйста, как активировать =Sub Udalenie()= только для переменных =iAB=?

Это как? Что-то не понятно.

...

Рейтинг:

0 / 0

21.09.2007, 13:42:21

| Ответить | Цитировать | Написать

Автофильтр

#34817913

nPUBET

Гость

vkodor
nPUBET
Подскажите, пожалуйста, как активировать =Sub Udalenie()= только для переменных =iAB=?

Это как? Что-то не понятно.
....запускаю =Sub OTRIC_2()= (всего около 10.000 строк, после сортировки остаётся видимых строк около 100), не могу дождаться конца (жду 6 минут, потом принудительно прерываю).
Т.е. =Sub OTRIC_2()= для 40 строк очень хорош, а вот если строк немного побольше (ок. 10.000) - то он уже не так эффективен.

Понимаете, пытаюсь сделать следующее:
1. Сортирую
2. Считаю по функции ="=ABS(RC[" & iNo - 33 & "])"= в 33-ом столбце.
3. Смотрю в столбец под номером =iAB=:
- если в этом столбце есть ячейки со значением =T?2=, тогда удаляю эти строки;
- если значение другое, прохожу мимо.

Т.е. хотел бы запускать =Sub Udalenie()= в =Sub OTRIC_2()= только для видимых строк.
Mожет это возможно как-то через Cells.SpecialCells(xlCellTypeVisible)?

...

Рейтинг:

0 / 0

21.09.2007, 14:17:28

| Ответить | Цитировать | Написать

Автофильтр

#34818072

vkodor

Участник

Откуда: Moscow

Сообщения: 1 809

Рейтинг: 0 / 0

nPUBET
Mожет это возможно как-то через Cells.SpecialCells(xlCellTypeVisible)?
Конечно можно, и это у тебя уже было.

Код: plaintext

Set rng = .Range("M2:M" & .Cells(Rows.Count,  11 ).End(xlUp).Row). _ 
       SpecialCells(xlCellTypeVisible)

если хочешь удалить все отобранные автофильтром строки это так

Код: plaintext

.Range("2:" & .Cells(Rows.Count, iNo).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Delete

...

Рейтинг:

0 / 0

21.09.2007, 14:46:56

| Ответить | Цитировать | Написать

25 сообщений из 51, страница 1 из 3

все

Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Автофильтр

Читали тему (0):

Читали форум (0):

Пользователи онлайн (0):

start [/forum/topic.php?fid=61&fpage=263&tid=2182184]:	0ms
get settings:	10ms
get forum list:	17ms
check forum access:	2ms
check topic access:	2ms
track hit:	21ms
get topic data:	13ms
get forum data:	2ms
get page messages:	200ms
get tp. blocked users:	1ms
others:	191ms

total:	459ms

	Необходимые cookie
	Cookie для сбора статистики
	Cookie для маркетинга и рекламы