Профессиональные приемы работы в Microsoft Excel

Обмен опытом => Microsoft Excel => Тема начата: GWolf от 21.11.2018, 13:51

Название: Переход с листа на лист по двойному клику мышки в ячейке
Отправлено: GWolf от 21.11.2018, 13:51
Доброго времени суток!

На событие листа SheetBeforeDoubleClick, в модуле ЭтаКнига "навесил" следующий макрос:
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    Dim c As Range
   
    Select Case Sh.Name
        Case "mtd"
   
            Set c = Range([A5], Sh.Cells(LastRow(Sh.Name) + 1, 1))

            If Not Intersect(c, Target) Is Nothing And Target.Text = "" Then '<<< Intersect
                With ThisWorkbook.Worksheets("BDMarsrutS")
                   
                    .Activate
                End With
            End If
    End Select
End Sub

Function LastRow(wSt As String) As Long
    Dim ra As Excel.Range, Item As Excel.Range
   
    Set ra = Worksheets(wSt).Cells.SpecialCells(2)    ' возвращает все ячейки со значениями
   
    LastRow = 0

    For Each Item In ra.EntireRow.Rows
        If Item.Row > LastRow Then LastRow = Item.Row
    Next Item
    Set ra = Nothing
End Function
, т.о. организовал переход с листа "mtd" на лист "BDMarsrutS".
Теперь, хотелось бы по ДКМ на листе "BDMarsrutS" вернуться на лист "mtd" и в строку, ячейки, откуда стартовал занести данные из ячейки листа "BDMarsrutS", по которой щелкнул ДКМ.

Один способ я знаю: при выполнении 1-й части, т.е.  ДКМ на листе "mtd", сохранять nR и nC стартовой ячейки на вспомогательном листе "ust". А при ДКМ на листе "BDMarsrutS", считывать эти значения в переменные, как координаты ячейки возврата. Вот так:Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    Dim c As Range '
    Dim arrN() As String '
    Dim i As Long '
    Dim nRTo As Long '
    Dim nCTo As Long '
    Dim wsNmeTo As String '
    Dim wbNmeTo As String '
   
    Select Case Sh.Name
        Case "mtd"
   
            Set c = Range([A5], Sh.Cells(LastRow(Sh.Name) + 1, 1))

            If Not Intersect(c, Target) Is Nothing And Target.Text = "" Then '<<< Intersect
                With ThisWorkbook
                    With .Worksheets("ust")
                        .Cells(2, 1) = Target.Row '
                        .Cells(3, 1) = Target.Column '
                        .Cells(4, 1) = Sh.Name '
                        .Cells(5, 1) = ThisWorkbook.Name '
                    End With
                    With .Worksheets("BDMarsrutS")
                        .Activate
                    End With
                End With
            End If
           
            Set c = Nothing
        Case "BDMarsrutS"
            If Target.Column = 1 Then
                i = 0
                For i = 1 To 5
                    If i = 1 Then
                        ReDim arrN(i - 1)
                        arrN(i - 1) = Target.Text
                    Else
                        ReDim Preserve arrN(i - 1)
                        arrN(i - 1) = Target.Offset(, i).Text
                    End If
                Next i
               
                With ThisWorkbook
                    With .Worksheets("ust")
                        nRTo = .Cells(2, 1).Value '
                        nCTo = .Cells(3, 1).Value '
                        wsNmeTo = .Cells(4, 1).Text '
                        wbNmeTo = .Cells(5, 1).Text '
                    End With
                   
                    With .Worksheets("mtd")
                        .Activate
                        i = 0
                        For i = LBound(arrN) To UBound(arrN)
                            .Cells(nRTo, i + 1) = arrN(i)
                        Next i
                       
                        Erase arrN
                    End With
                End With
            End If
    End Select
End Sub

Function LastRow(wSt As String) As Long
    Dim ra As Excel.Range, Item As Excel.Range
   
    Set ra = Worksheets(wSt).Cells.SpecialCells(2)    ' возвращает все ячейки со значениями
   
    LastRow = 0

    For Each Item In ra.EntireRow.Rows
        If Item.Row > LastRow Then LastRow = Item.Row
    Next Item
    Set ra = Nothing
End Function



Но, нельзя ли при возврате как-то обратится к ячейке старта? Без сохранения ее координат.

Вроде объяснил. Если не понятно объясню еще. Может кто знает решение?

Название: Re: Переход с листа на лист по двойному клику мышки в ячейке
Отправлено: boa от 21.11.2018, 15:06
Здравствуйте,
В обыкновенном модуле объявите Паблик переменную, например:
Public MeRange As Range
потом переходя в одну сторону присваиваете ей значение
Set MeRange = Target
а возвращаясь, считываете из неё.