Доброго времени суток!
На событие листа 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
Но, нельзя ли при возврате как-то обратится к ячейке старта? Без сохранения ее координат.
Вроде объяснил. Если не понятно объясню еще. Может кто знает решение?
Здравствуйте,
В обыкновенном модуле объявите Паблик переменную, например:
Public MeRange As Range
потом переходя в одну сторону присваиваете ей значение
Set MeRange = Target
а возвращаясь, считываете из неё.