Страницы: 1
RSS
найти в каждой строке четкое совпадение и записать его, макросом
 
Добрый день.

Скажите пожалуйста как модифицировать макрос, чтобы он находил в каждой строчке четкое значение и выводил его в файл, то есть мне нужно найти в первой строчке  все значения которые = 8, потом во второй строчке и так далее, данный макрос почему то не оставляет такие значения, в чем тут ошибка?

Код
Sub FilterFrom2To8()
Dim i As Long
 
    With ActiveSheet
        If .AutoFilterMode = True Then .AutoFilterMode = False
        .Rows(1).AutoFilter
        For i = 1 To .UsedRange.Columns.Count
            .UsedRange.AutoFilter Field:=i, Criteria1:=">=8", Operator:=xlAnd, Criteria2:="<=9"
        Next i
    End With
End Sub
 
мне кажется вы запутались,
- файл называется от 2 до 8
- в тексте описания РАВНО 8
- в представленном коде >=8 и <=9
- в коде в файле от 1 до 10
Вроде всё работает - макрос фильтрует (кроме первой строки - так как это шапка таблицы, она никогда не попадает в зону фильтрации)

P.S. Вы же знаете, что обычно показывают начальные данные, а рядом (на соседнем) листе желаемый результат. А вы дали 700 строк 45 столбцов данных и везде указали разные критерии для отбора, не показав нам желаемый результат.
Изменено: New - 08.04.2021 15:41:32
 
добавил на второй лист то что хочу получить, это нужно сделать для первых 30 строк с первой странице. а строки рядом с 1 до 15, это то что должно получиться при фильтре в одной из строк.
 
Коллеги, кто-нибудь понял задание? Я вот хочу помочь, но как-то не догоняю, даже с показанным результатом...
 
New, все норм, мне тоже не понятно,но это почти всегда обычное состояние при посещении тем от DJMC,  :D  не в обиду DJMC)
я кажется понял))))
1=8 - это значит столбец c номером 1 фильтруется по значению 8 - и после строки офильтрованные копируем, т.е. строки в диапазоне столбцов AE:AS...

только автор видимо путает строки со столбцами
Код
Sub mrshkei()
Dim lr As Long, lcol As Long, i As Long, n As Long, sh As Worksheet
lr = Cells(Rows.Count, 1).End(xlUp).Row
Set sh = Worksheets("моя хотелка")
sh.Cells.ClearContents
lcol = 46
x = 8
arr = Range(Cells(2, 1), Cells(lr, lcol))
For i = 1 To 30
xxx = 1
ReDim arr2(1 To lr, 1 To 15)
    For n = LBound(arr) To UBound(arr)
        If arr(n, i) = x Then
        For k = 31 To 45
            arr2(xxx, k - 30) = arr(n, k)
        Next k
        xxx = xxx + 1
        End If
    Next n
    With sh
    lrr = .Cells(Rows.Count, 1).End(xlUp).Row + 1
    .Cells(lrr, 1) = i & "=" & x
    .Cells(lrr + 1, 1).Resize(UBound(arr2), 15) = arr2
    .Activate
    End With
Next i
End Sub
Изменено: Mershik - 08.04.2021 21:14:56
Не бойтесь совершенства. Вам его не достичь.
 
Mershik
Спасибо за решение, и за то что смогли меня понять,  когда ни будь я научусь правильно выражать свои мысли.
Еще такой вопрос, а этот макрос быстро у Вас работает? у меня занимает 10 минут, когда нажимаю на кнопку.
 
DJMC, в приведенном примере? - ну 0,6445313  сек.
добавил еще строк до:
6900 -  4,375 сек.
13600 - 8,695313  сек.
55 240 -  36,90625  сек.
Изменено: Mershik - 09.04.2021 11:02:40
Не бойтесь совершенства. Вам его не достичь.
 
странно почему у меня так долго, глупый вопрос, когда  я нажимаю кнопку в данном макросе, имеет ли значение открыты ли другие файл эксель или нет?
 
DJMC, думаю да, если  их очень много, хотя странный вопрос можно было самому проверить
Изменено: Mershik - 09.04.2021 11:05:27
Не бойтесь совершенства. Вам его не достичь.
 
Цитата
DJMC: имеет ли значение открыты ли другие файл эксель или нет?
всегда лучше работать только с 1 файлом, если есть возможность
Я, например, переношу данные в один файл, закрываю все остальные и только потом начинаю работать - это сильно помогает
Кроме этого, в макросе нет отключения автопересчёта, а значит он сработает (если есть) 1+ 30 раз (очистка + вставка в цикле) и во всех открытых книгах
Если в открытых книгах есть умные таблицы, да ещё и отфильтрованные, то вообще пиши пропало - пересчёт отфильтрованных данных почему-то в десятки раз медленнее

Есть ещё много "приколов" с "умными"…
Изменено: Jack Famous - 09.04.2021 13:28:34
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Доброе врем
Цитата
Jack Famous написал:
Есть ещё много " приколов " с "умными"…
Может уже пора использовать Power Query? :)
Страницы: 1
Наверх