Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Выделение самой нижней заполненной ячейки того столбца, на котором находится фигура
 
#1
07.04.2018 19:11:20
Добрый день. Подскажите - как макросом - при щелчке на фигуре - переместится на ту ячейку - которая является самой нижней заполненной ячейкой столбца, на котором располагается фигура ?

Сейчас фигура находится на столбце "I"  - значит при щелчке по ней, курсор должен выделить ячейку I53 - которая заполнена пробелом.
 
 
 
#2
07.04.2018 19:15:09
а I67-I70 не всчет?
По вопросам из тем форума, личку не читаю.
 
 
 
#3
07.04.2018 19:19:25
БМВ, ну да - то есть последней ячейкой тут является I70
 
 
 
#4
07.04.2018 19:27:29
Код
Sub LastCellSelect()
Dim iNm$, iClmn&, iRow&
Dim iCell As Range
iNm = Application.Caller
With ActiveSheet
    Set iCell = .Shapes(iNm).TopLeftCell
    If Not iCell Is Nothing Then
        iClmn = iCell.Column
        iRow = .Cells(.Rows.Count, iClmn).End(xlUp).Row
        .Cells(iRow, iClmn).Select
    End If
End With
End Sub
Согласие есть продукт при полном непротивлении сторон
 
 
 
#5
07.04.2018 19:31:12
Sanja, все нормально. Спасибо.
 
 
 
#6
07.04.2018 19:41:38

ой, а у меня так

Код
Sub moveObj()
    With ActiveSheet
        Set MCell = Cells(Cells.Rows.Count, .Shapes(1).TopLeftCell.Column).End(xlUp).Offset(1)
        .Shapes(1).Top = MCell.Top
        MCell.select
    End With
End Sub
Изменено: БМВ - 07.04.2018 19:47:15
По вопросам из тем форума, личку не читаю.
 
 
 
#7
07.04.2018 19:45:16
Михаил, так там вроде не надо сам шейп перемещать, просто
Цитата
Dim Ozerov написал: переместится на ту ячейку...курсор должен выделить ячейку
Согласие есть продукт при полном непротивлении сторон
 
 
 
#8
07.04.2018 19:50:31
:-( совсем скучно, я ж говорил, макросы не мое, я уж было навострился плавно фигуру перемещать :-)
Код
Sub moveObj()
        Cells(Cells.Rows.Count, ActiveSheet.Shapes(1).TopLeftCell.Column).End(xlUp).Offset(1).Select
End Sub
ну или для корректности
Код
Sub moveObj()
        Cells(Cells.Rows.Count, ActiveSheet.Shapes(Application.Caller).TopLeftCell.Column).End(xlUp).Offset(1).Select
End Sub
Изменено: БМВ - 07.04.2018 19:56:12
По вопросам из тем форума, личку не читаю.
 
 
 
Страницы: 1
Наверх