VBA - как обратиться к ячейке определённого столбца текущей строки?

[Виктория Зуева]

Здравствуйте!
Подскажите, пожалуйста, как сделать. Пример файла прилагаю.

На защищённом листе стрОки в таблице добавляются и удаляются макросом. Разрешено выделение только незаблокированных ячеек.
Добавление строки идёт в конце таблице (фактически - перед розовой строкой копируется "эталонная" 3-я строка),
а вот удаление д.б. возможно для любой строки внутри таблицы.
НО при удалении не последней строки данных "слетает" формула в столбце F, т.к. она ссылалась на ячейку в удалённой строке.
Как прописать в макросе обращение к ячейке на пересечении текущей строки и столбца F?
(столбец F - самый правый заполненный в таблице)

[vikttur]

Для строки 13:

Код Выделить Развернуть

=ЕСЛИ(СУММ(C13:D13)>0;ИНДЕКС($F$1:F13;СТРОКА()-1)+C13-D13;"")
Если достаточно этого, измените название темы.

Если макросы разрешены, то формулу писать совсем не обязательно: результат пересчитывать по событию изменения влияющих ячеек.

[Виктория Зуева]

Спасибо за идею! + к карме добавила.

Я пока тему оставлю, КАК ЕСТЬ.
Мне интересно, как это в коде прописать - как обратиться к ячейке определённого столбца текущей строки?

[Serge 007]

Здравствуйте Виктория. Что-то Вы у нас совсем редко стали бывать

...как это в коде прописать - как обратиться к ячейке определённого столбца текущей строки?

Код Выделить Развернуть

Sub УдалитьСтроку()
    Dim Rez As Integer
   
    Rez = MsgBox("Удалить текущую строку?", vbYesNo, "Внимание!")
       
        If Rez = vbYes Then
           
     ' в строке ниже изменить пароль для листа
            ActiveSheet.Unprotect Password:="1"
           
            With ActiveCell
                Rows(.Row).Delete
            End With
           
            ' и ВОТ ТУТ надо для ставшей _текущей_ (ниже удалённой) строки "поправить"
            ' съехавшую ссылку в формуле столбца F
           
            ActiveCell.End(xlToRight).Select
            Cells(ActiveCell.Row, 6).FormulaR1C1 = "=IF((RC[-2]+RC[-3])<0,"""",R[-1]C+RC[-3]-RC[-2])"
     
      ' в строке ниже изменить пароль для листа
            ActiveSheet.Protect Password:="1", UserInterfaceOnly:=True

           
        Else
        Exit Sub
       
        End If
End Sub

[Виктория Зуева]

О, да!!!
Вот ответ на мой вопрос:
Cells(ActiveCell.Row, 6)

(Вдруг кому ещё интересно будет - вот этот переход

Код Выделить Развернуть

ActiveCell.End(xlToRight).Select
тут был совсем не нужен)

Сергей, СПАСИБО!
Ура!!!

Да, Сергей, отбилась я от СОобщества и начала стремительно тупеть, как видите!
(гением в макросах, собственно, никогда и не была...)

[_Boroda_]

Вика, привет!!!
Как давно тебя не было! Куда пропала?

По поводу файла - у тебя сознательно в F22 другая формула?
А макросы можно еще так (поменял и первый, и второй: в первом убралСелекшны ячеек, во втором просто копирую формулу из ячейки выше и изменил текст вопроса - ведь удалять можно и несколько строк подряд)

Код Выделить Развернуть

Sub ВставитьСтроку()
    On Error Resume Next: Application.ScreenUpdating = False
    Dim r_
    ' в строке ниже изменить пароль для листа
    ActiveSheet.Unprotect Password:="1"
    Range("B3:F3").Copy
    r_ = Range("B12").End(xlDown).Row
    Cells(r_, 2).Insert Shift:=xlDown
    Cells(r_, 2) = Date
    Application.CutCopyMode = False
    ' в строке ниже изменить пароль для листа
   ActiveSheet.Protect Password:="1", UserInterfaceOnly:=True
End Sub

Sub УдалитьСтроку()
        If MsgBox("Удалить текущие строки?", vbYesNo, "Внимание!") = vbYes Then
         ' в строке ниже изменить пароль для листа
            ActiveSheet.Unprotect Password:="1"
            Selection.EntireRow.Delete
            Cells(Selection.Row, 6) = Cells(Selection.Row - 1, 6).Formula
           ' Cells(Selection.Row, 6).FormulaR1C1 = "=IF((RC[-2]+RC[-3])<0,"""",R[-1]C+RC[-3]-RC[-2])"
       ' в строке ниже изменить пароль для листа
            ActiveSheet.Protect Password:="1", UserInterfaceOnly:=True
        End If
End Sub

[Виктория Зуева]

Привет, Борода!!!

Саша, каюсь, с форумов пропадала, но я "в строю" - в соц.сетях "поддерживаю" пользователей!  Хотя это совсем на другом уровне...
Твои гениальные (как всегда!) примеры макросов изучила,  и задам ещё вопрос, ладно?

В этой же процедуре удаления строк - как разрешить удаление одной или нескольких строк ТОЛЬКО при условии, что в ячейках столбцов С И D нет данных?

По поводу файла - у тебя сознательно в F22 другая формула?

Вот тут я не поняла, почему в файле твоего вложения ДО F22 - другая формула! А у меня с 13 строки д.б. одинаковые...

[_Boroda_]

Вик, так хотела?

Код Выделить Развернуть

Sub УдалитьСтроку()
Application.ScreenUpdating = 0
    If Cells(Selection.Row, 3) & Cells(Selection.Row, 4) = "" Then
    If Selection.Rows.Count = 1 Then
        If MsgBox("Удалить текущую строку?", vbYesNo, "Внимание!") = vbYes Then
         ' в строке ниже изменить пароль для листа
            ActiveSheet.Unprotect Password:="1"
            Selection.EntireRow.Delete
            Cells(Selection.Row, 6) = Cells(Selection.Row - 1, 6).Formula
            'или так
           ' Cells(Selection.Row, 6).FormulaR1C1 = "=IF((RC[-2]+RC[-3])<0,"""",R[-1]C+RC[-3]-RC[-2])"
       ' в строке ниже изменить пароль для листа
            ActiveSheet.Protect Password:="1", UserInterfaceOnly:=True
        End If
    End If
    End If
Application.ScreenUpdating = 1
End Sub[code]
А формулы поменялись - это я игрался. Я ж не могу не пошалить.
В твоем родном файле только в F22 поменятая формула.


[vikttur]

Код в модуле листа:

Код Выделить Развернуть

' вставка/удаление строки
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim lRws As Long
Dim lMsg As Long
    If Application.Intersect(Range("A12:A5000,C12:C5000"), Target) Is Nothing Then Exit Sub
    lRws = Target.Row
    Application.ScreenUpdating = False
   
    Select Case Target.Column
        Case 1
            Rows(lRws).Copy ' копировать строку
            Rows(lRws + 1).Insert Shift:=xlDown ' вставить строку
            Rows(ActiveCell.Row + 1).ClearContents ' удалить данные
        Case 3
            lMsg = MsgBox("Подтверждаете удаление строки?", vbYesNo + 64, "УДАЛЕНИЕ СТРОКИ")
            If lMsg = 6 Then Rows(lRws).Delete ' удалить строку
    End Select
   
    ActiveCell.Offset(1, 1).Select
   
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
    End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lRws As Long
    If Target.Cells.Count > 1 Then Exit Sub
    If Not Application.Intersect(Range("C13:D5000,F13:F5000"), Target) Is Nothing Then
        With Application: .ScreenUpdating = False: .EnableEvents = False: End With
       
        lRws = Target.Row
        Cells(lRws, 6) = Cells(lRws - 1, 6) + Cells(lRws, 3) - Cells(lRws, 4)
               
        With Application: .ScreenUpdating = True: .EnableEvents = True: End With
    End If
End Sub
Двойной клик на ячейке столбца А - добавление строки.
Двойной клик на ячейке столбца С - удаление строки строки.
Изменение ячеек C, D, F - пересчет ячейки столбца F.
ячейки F добавлены на случай случайного (или преднамеренного) изменения суммы.

Не добавил пересчет ячеек в столбце F ниже изменяемой строки. Сами.

[Виктория Зуева]

Ой, ну как же я люблю умных мужчин!
Сейчас сяду разбираться, про что же тут ТАКОГО и СТОЛЬКО написано... ))