Страницы: 1 2 След.
RSS
Выделение только видимых ячеек VBA
 
Здравствуйте.

Имеется файл с двумя листами - "НетФильтра" и "ЕстьФильтр".

На первом листе имеется таблица и кнопка с кодом:
Код
Sub НетФильтра()
    Range([A1].Offset(1, 2).Resize(2, 1).Address).Select
End Sub

Он выделяет две ячейки сразу под надписью "Числитель".

На втором листе имеется аналогичная первому листу таблица, но с фильтром (скрыты некоторые строки) и кнопка с кодом:
Код
Sub ЕстьФильтр()
    Range([A1].Offset(1, 2).Resize(2, 1).SpecialCells(xlCellTypeVisible).Address).Select
End Sub

Мною подразумевалось, что SpecialCells(xlCellTypeVisible) будет выделять только видимые ячейки, но это не так - выдается ошибка, мол нет ячеек по условию.

Подскажите плиз, как произвести выделение по видимым ячейкам на втором листе в рамках текущего кода (это важно, т.к. код будет использоваться в формуле)? При условии, что начальная ячейка - А2 (как и видно в коде), и что фильтр может быть разным, то есть вместо Resize(2, 1) в коде должно быть выделение до конца видимых ячеек столбца.

Итоговый вид, как я предполагаю, должен быть примерно таким:
Код
Range([A1].Offset(1, 2).Selection.End(xlDown).SpecialCells(xlCellTypeVisible).Address).Select

Да, он неправильный, но суть, надеюсь понятна - смещение от ячейки A1 вправо на два столбца и одну ячейку вниз, и дальнейшее выделение вниз до первой пустой видимой ячейки.
Изменено: andronus - 21.02.2019 17:21:53
 
Попробуйте:
Код
Sub естьфильтр()
    'Range([A1].Offset(1, 2).Resize(2, 1).SpecialCells(xlCellTypeVisible).Address).Select
    
    With ActiveSheet.Range("A1").CurrentRegion
        .Offset(1, 2).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible).Select
    End With
End Sub
 
ocet p, а вы пробовали? У меня ошибка "Object Required".
К тому же, ваш код не подходит по условию, что я писал. По сути, важен код именно между скобками Range().Select, потому что, повторюсь, значение из скобок будет использоваться в формуле. Селект тут просто для проверки, что выделяется верная область.
Изменено: andronus - 21.02.2019 17:45:54
 
andronus, в пошаговом режиме выполните след.код:
Код
Sub aaa()
Set aa = Intersect(Columns("A:C"), ActiveSheet.UsedRange).SpecialCells(xlCellTypeVisible)
For Each bb In Intersect(aa, Columns(1))
t = bb.Address
Next
End Sub
Изменено: Anchoret - 21.02.2019 18:28:56
 
Anchoret, прошу, прочтите еще раз внимательнее мои слова - нужно изменить код только в скобках Range().Select, потому что это значение будет применяться в формуле. Он должен выглядеть как-то так:
Код
Range([A1].Offset(1, 2).Selection.End(xlDown).SpecialCells(xlCellTypeVisible).Address).Select

Вот с Range([A1].Offset(1, 2).Address).Select всё нормально. Нужно всего лишь (просто я не знаю как):
1. После Offset(1, 2) добавить выделение вниз до окончания непрерывных данных.
2. После №1 добавить условие выделения только видимых ячеек. Без этого, кстати, можно обойтись, если в №1 всё нормально будет.

Я не верю, что нельзя сделать макросом то, что я могу сделать руками. Я перерыл гугл, кучу зарубежных сайтов, справок и прочего. На вас последняя надежда...
Изменено: andronus - 21.02.2019 18:35:15
 
andronus, Вы лучше скажите зачем Вам формула через макрос, когда все можно сделать макросом?

Ну и как предположил в прошлой Вашей теме структура файла примера явно отличается от структуры файла, где это все планируется применить.
Вместо попыток почесать левую ногу через голову лучше расскажите (если действительно хотите решить свою задачу) что Вы пытаетесь добиться всеми этими манипуляциями. Лично я пока смысла в них не вижу...
Изменено: Anchoret - 21.02.2019 18:48:48
 
Anchoret, это совсем неважно, но поясняю. Есть задача, в рамках которой в ячейки столбца А будут вставляться формулы, содержащие в себе суммы значений выделенных диапазонов, вот так:
Код
FormulaResult.Range("A2").Value = "Выделение числителя / Выделение знаменателя"

Но т.к. могут отфильтровываться некоторые строки, то нельзя использовать жестко объявленные диапазоны типа Range("C1:C2") или изменение размеров выделения типа Resize(2, 1).
Изменено: andronus - 21.02.2019 18:56:06
 
andronus,не правильный ответ. Какую задачу Вы пытаетесь решить с помощью этих манипуляций?

Для указанного выше действа (точкой отсчета является активная ячейка):
Код
Sub bbb()
Dim aa As Range, a&, bb As Range
Set aa = Intersect(ActiveCell.EntireRow, Columns(3))
a = aa.Row + 1: Set bb = aa.Offset(, -1)
Do While Cells(a, 3).EntireRow.Hidden = True
  a = a + 1
Loop
Set aa = Union(aa, Cells(a, 3)): aa.Select
bb.Offset(, -1).Formula = "=" & "(" & "sum(" & aa.Address & "))" & "/" & bb.Address
End Sub
Изменено: Anchoret - 21.02.2019 19:19:40
 
Anchoret, вставка формулы в столбец. В формуле значения числителя и знаменателя берутся из выделений.
У меня уже готово решение, если на листе нет строк, скрытых фильтром. А если с фильтром, то беда, посему осталось только выяснить, как в Range([A1].Offset(1, 2).Address).Select:
1. После Offset(1, 2) добавить выделение вниз до окончания непрерывных данных.
2. После №1 добавить условие выделения только видимых ячеек. Без этого, кстати, можно обойтись, если в №1 всё нормально будет.

Я уже повторяюсь.
 
Anchoret, у вас прям целый саб, но он не нужен, к сожалению.
Вы знаете, как в Range([A1].Offset(1, 2).Address).Select добавить после оффсета выделение вниз до окончания непрерывных данных?
Или это в принципе невозможно? В чем я сильно сомневаюсь.
 
andronus, все по последнему вопросу. наслаждайтесь:
Код
Set bb = Range(Cells([A1].Offset(1, 2).Row, [A1].Offset(1, 2).Column), Cells([A1].Offset(1, 2).Row + Range(Cells([A1].Offset(1, 2).Row, [A1].Offset(1, 2).Column), Cells(Cells(Rows.Count, [A1].Offset(1, 2).Column).End(xlUp).Row, [A1].Offset(1, 2).Column)).SpecialCells(xlVisible).Rows.Count - 1, [A1].Offset(1, 2).Column))
t = bb.Address

Но если строка
Код
[A1].Offset(1, 2).Row
будет скрыта (2-я строка) фильтром или руками, то выдаст ошибку.
Можно еще усложнить - от первой не скрытой строки считая от второй строки и до первой скрытой строки по столбцу "C":
Код
Set bb = Range(Cells(Range(Cells([A1].Offset(1, 2).Row, [A1].Offset(1, 2).Column), Cells(Cells(Rows.Count, _
    [A1].Offset(1, 2).Column).End(xlUp).Row, [A1].Offset(1, 2).Column)).SpecialCells(xlVisible).Row, _
    [A1].Offset(1, 2).Column), Cells([A1].Offset(1, 2).Row + Range(Cells([A1].Offset(1, 2).Row, [A1].Offset(1, 2).Column), _
    Cells(Cells(Rows.Count, [A1].Offset(1, 2).Column).End(xlUp).Row, [A1].Offset(1, 2).Column)).SpecialCells(xlVisible).Rows.Count - 1, [A1].Offset(1, 2).Column))
t = bb.Address: bb.Select
Изменено: Anchoret - 21.02.2019 20:38:41
 

andronus, хочете или не хочете, надо это сделать циклом, используя например "Areas", потому что вы никогда не будете знали которые строки будут скрытыми а которые нет, это зависит от критериев фильтрации. Тут для вас инфо как использовать "Areas":

https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=114353&...

Смотрите #5 - Jack Famous

... или может #4 - Nordheim ... (?) ... без "Areas"

Изменено: ocet p - 21.02.2019 21:16:04
 
Код
Sub ЕстьФильтр()
    With ActiveSheet.AutoFilter.Range
        x = Range(.Item(1).Offset(1, 2).Resize(, 1), .Item(1).Offset(1, 2).Resize(, 1).End(xlDown)).SpecialCells(xlCellTypeVisible).Address
    End With
End Sub
Изменено: RAN - 21.02.2019 23:01:01
 
Код
Sub ЕстьФильтр_1()
With ActiveSheet.AutoFilter.Range
x = .Columns(3).SpecialCells(2, 1).SpecialCells(12).Address
End With
End Sub
 
Код
   1 ActiveSheet.AutoFilter.Range.Offset(1, 2).SpecialCells(xlCellTypeVisible).Select
   2 Selection.Resize(2, 1).Select
такой еще чутка кривовато-страноватый способ. Ну, мало ли. Вдруг подойдет.
Изменено: Paul Zealand - 22.02.2019 06:07:01
 
Цитата
Anchoret написал:
все по последнему вопросу. наслаждайтесь:
Не работает.
RAN, тоже не работает.
k61, тоже не работает

Всем спасибо за участие. С сожалением для себя узнал, что не всё можно сделать макросами. За ночь приняли решение делать эту часть задачи вручную, благо часть не такая большая ожидается. Еще раз всем спасибо.
 
andronus, не знаю куда Вы добавляли код из предложенных вариантов, но свой я тестировал на Вашем же файле-примере. Полагаю остальные участники тоже.

Тестовый файл с тремя вариантами
Изменено: Anchoret - 22.02.2019 15:18:20
 
Цитата
andronus написал:
Мною подразумевалось, что SpecialCells(xlCellTypeVisible) будет выделять только видимые ячейки, но это не так - выдается ошибка, мол нет ячеек по условию.
Нельзя выделить видимые ячейки, если все ячейки - невидимые. Естественно, что выдается ошибка.
Цитата
andronus написал:
В формуле значения числителя и знаменателя берутся из выделений.
... м.б. Вам просто воспользоваться функцией =ПРОМЕЖУТОЧНЫЕ.ИТОГИ() ? Она как раз использует только видимые ячейки.
Цитата
andronus написал:
С сожалением для себя узнал, что не всё можно сделать макросами. За ночь приняли решение делать эту часть задачи вручную
Вы просто не всё узнали. И отказались найти ответ на свой вопрос. А ночь - не лучшее время для принятия решений.
Изменено: Михаил Лебедев - 25.02.2019 10:20:38
Всё сложное - не нужно. Всё нужное - просто /М. Т. Калашников/
 
Думаю, вопрос решен, найден воркараунд на зарубежных сайтах. Можно выделять первую видимую ячейку под фильтром, а дальше уже перемещаться по диапазонам.

Вариант раз:
Код
Option Explicit

Sub move_right()
NextVisible "Right"
End Sub

Sub move_left()
NextVisible "Left"
End Sub

Sub move_up()
NextVisible "Up"
End Sub

Sub move_down()
NextVisible "Down"
End Sub

Private Sub NextVisible(direction As String)
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

Dim i As Long
Dim r As Range
Set r = ActiveCell
For i = 1 To Rows.Count
    On Error Resume Next 'If you're in A1 and try to go up one, it'll error. This skips that error.
    Select Case direction
        Case "Up"
            Set r = r.Offset(-1, 0)
        Case "Down"
            Set r = r.Offset(1, 0)
        Case "Left"
            Set r = r.Offset(0, -1)
        Case "Right"
            Set r = r.Offset(0, 1)
        Case Else
            Set r = r
    End Select
    On Error Goto 0

    If r.EntireRow.Hidden = False And r.EntireColumn.Hidden = False Then
        r.Select
        Exit Sub
    End If
Next i

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub

Но он слишком громоздок и несколько сабов это не дело.

Вариант два, наиболее подходящий (перемещает на одну ячейку вниз даже при наличии фильтра):
Код
Dim rng As Range
Set rng = Range(Cells(ActiveCell.Row + 1, ActiveCell.Column), Cells(Rows.Count, ActiveCell.Column))
Изменено: andronus - 25.02.2019 11:59:59
 
Цитата
andronus написал:
Думаю, вопрос решен, найден воркараунд на зарубежных сайтах
смешно... :)

Цитата
andronus написал:
Вариант два, наиболее подходящий (перемещает на одну ячейку вниз даже при наличии фильтра):
Код
Dim rng As Range
Set rng = Range(Cells(ActiveCell.Row + 1, ActiveCell.Column), Cells(Rows.Count, ActiveCell.Column))
не верю :)
Всё сложное - не нужно. Всё нужное - просто /М. Т. Калашников/
 
Цитата
Михаил Лебедев написал:
смешно...  
Что смешного в том, что интернет не ограничен Россией (по крайней мере, пока. И, как говорится, не дай бог)? На зарубежных сайтах тоже море инфы.
Цитата
Михаил Лебедев написал:
не верю
Так вы проверьте для начала. Вот такой код у меня прекрасно работает:
Код
Sub test2()

Application.DisplayAlerts = False

Dim rng As Range

Range("A3").Select
ActiveSheet.Range("$A$3:$F$23").AutoFilter Field:=1, Criteria1:="1"
Set rng = Range(Cells(ActiveCell.Row + 1, ActiveCell.Column), Cells(Rows.Count, ActiveCell.Column))
rng.SpecialCells(xlCellTypeVisible).Cells(1).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Offset(0, 3).Select
Selection.Merge
With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
End With

Range("A3").Select
ActiveSheet.Range("$A$3:$F$23").AutoFilter Field:=1, Criteria1:="2"
Set rng = Range(Cells(ActiveCell.Row + 1, ActiveCell.Column), Cells(Rows.Count, ActiveCell.Column))
rng.SpecialCells(xlCellTypeVisible).Cells(1).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Offset(0, 3).Select
Selection.Merge
With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
End With

Range("A3").Select
ActiveSheet.Range("$A$3:$F$23").AutoFilter Field:=1, Criteria1:="3"
Set rng = Range(Cells(ActiveCell.Row + 1, ActiveCell.Column), Cells(Rows.Count, ActiveCell.Column))
rng.SpecialCells(xlCellTypeVisible).Cells(1).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Offset(0, 3).Select
Selection.Merge
With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
End With

End Sub

Осталось его в цикл запихнуть, а вот это я не знаю как.
Изменено: andronus - 25.02.2019 13:10:49
 
andronus, не понимаю чего Вы мучаетесь, найти первую видимую ячейку после фильтра не составляет большого труда. Дальше если Вам нужно использовать формулу в этих ячейках, то просто объявите переменную. У меня идеентичная необходимость была на днях. Решил подобным примитивным способом.
Код
1 Dim x As Range
2 Set x = Range("A5").End(xlDown) 'в 5 строке у меня автофильтр. x в итоге всегда будет первой ячейкой когда активен фильтр
3
4 Range("A5").End(xlDown).Select 'встаешь на любой столбец, где есть автофильтр. Опускаешься на первую ячейку после фильтра
5 ActiveCell.Offset(0, 5).Select 'дальше оффсетишь куда тебе надо  
6 ActiveCell.Formula = "=VLOOKUP(" & x.Address & ",'SHEET2'!$A:$BM,19,0)" 'если в формуле надо использовать просто сделай ее переменной
7 End If
Изменено: Paul Zealand - 28.02.2019 09:31:27
 
andronus, в Вашем файле такой код работает.
Код
1 Dim x, y As Range
2 Set x = Range("A1").End(xlDown)
3 Set y = x.Offset(-1, 2)
4 Set Z = y.Offset(1, 0)
5 Z.Select
6
7 Range(y, Z).Select
Изменено: Paul Zealand - 28.02.2019 09:43:21
 
Paul Zealand, спасибо, решение уже было найдено выше.
 
OFF:
Цитата
andronus: найден воркараунд
почему не просто "костыль" (слэнг) или дословно "обходной приём"  :D
но даже это не настолько забавно, как как эти процедуры  :D

По "задаче": неуменеие/нежелание правильно сформулировать проблему не даёт получить решение. С другой стороны, работает и ладно — но это путь тёмной стороны силы  ;)
Изменено: Jack Famous - 28.02.2019 12:11:53
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Jack Famous,  "костыль" (слэнг) это не обходной прием, а что-то рабочее, но ненадежное. Прямой аналог с обычным медицинским костылем, когда это помогает двигаться, но неполноценно.
По вопросам из тем форума, личку не читаю.
 
Jack Famous, окей, я использовал неверный термин, по вашему мнению. Тем не менее, решение найдено, и оно рабочее на 100%, можно применять его в дальнейшем. Вот оно, повторюсь:
Код
Dim rng As Range
Set rng = Range(Cells(ActiveCell.Row + 1, ActiveCell.Column), Cells(Rows.Count, ActiveCell.Column))


Изначально задача звучала так - выделять определенные ячейки. Как - неважно. Ни один из предложенных вариантов не подошел. Зато подошел вариант, который позволяет выделить ячейку сразу под фильтром, а дальше уже от нее плясать по диапазонам. И это решение оказалось идеальным в данном случае.
Задача была, решение найдено - это ли не результат?
 
БМВ, в данном случае, абсолютно надежное и работающее решение. Я не могу показать вам код целиком (конфиденциальность на проекте), но тем не менее, всё прекрасно работает.
 
Цитата
БМВ: что-то рабочее, но ненадежное
я запомнил это именно как "обходной приём", потому что большинство "костылей", встречавшихся мне, весьма надёжны и, как раз, выполняют свою реальную/жизненную функцию, только не "помогает двигаться, но неполноценно", а "позволяет выполнять повседневные задачи, пока нога не заживёт (читай, "разрабы не подсуетятся")"  :D
Одними из ярких примеров как раз являются "костыли" в макросах для работы с отфильтрованными диапазонами (в частности, вставка в фильтр и удаление только видимых строк)

Цитата
andronus: Задача была, решение найдено - это ли не результат?
а где вы видите противоречие с
Цитата
Jack Famous: С другой стороны, работает и ладно
Изменено: Jack Famous - 28.02.2019 12:45:07
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
Jack Famous написал:
а где вы видите противоречие с
Мне показалось, это было сказано с каким-то недоверительным подтекстом.

Впрочем, мы уже в явный оффтоп скатились.

Тему можно закрывать, всем огромное спасибо за участие!
Страницы: 1 2 След.
Наверх