K
Good decision. The other one's easier.The author ' s code can be optimized a little:Private Sub Worksheet_Change(ByVal Target As Range)
Dim op As Range, c As Range
Dim te As Boolean
Set op = Union(Range("A1:A2"), Range("A4:A5"), Range("A9:A10"))
If Not Intersect(Target, op) Is Nothing Then
For Each c In op
If c.Address = Target.Address Then
te = True
Else
If te = True Then c.Select: Exit For
End If
Next c
End If
End Sub
' -----------------------------------
What's lower is harder. Only as an option, some thoughts might be useful.If there are many values in the formed range or frequent working with it, the filling may be taken into a separate procedure and completed once. The code shall be located in the general module:' публичные переменные, могут использоваться в модуле листа
Public ArrR(), op As Range
' заполнение массива
Sub FillingOfArrays()
Dim c As Range
Dim j As Long
With ActiveSheet
' создание диапазона из отдельных диапазонов листа
Set op = Union(.Range("A1:A2"), .Range("A4:A5"), .Range("A9:A10"))
End With
ReDim ArrR(1 To 2, 1 To 1) ' определение начальной размерности массива
' первая "строка" - для записи номеров строк, вторая - для номеров столбцов
' если количество ячеек диапазона op заранее известно,
' в цикле переопределение размерности (ReDim Preserve) можно исключить
For Each c In op
j = j + 1 ' счетчик элементов массива
ReDim Preserve ArrR(1 To 2, 1 To j) ' добавляем элемент массива
ArrR(1, j) = c.Row ' запись строки адреса ячейки
ArrR(2, j) = c.Column ' запись столбца адреса ячейки
Next c
End Sub
In the leaf module:' перед работой с диапазоном нужно заполнить массив ArrR и диапазон op
' пример: при активации листа
Private Sub Worksheet_Activate()
Call FillingOfArrays ' к заполнению массива
End Sub
' при изменении значения переход между ячейками диапазона
Private Sub Worksheet_Change(ByVal Target As Range)
Dim j As Long
If Not Intersect(Target, op) Is Nothing Then ' только при изменениях в op
With Target ' родитель
For j = 1 To UBound(ArrR, 2) ' цикл по массиву строка/столбец
If .Row = ArrR(1, j) And .Column = ArrR(2, j) Then
' строка/столбец изменяемой ячейки найдены в массиве
If j = UBound(ArrR, 2) Then ' если последняя ячейка диапазона
' переход к первой ячейке диапазона
Cells(ArrR(1, 1), ArrR(2, 1)).Select
Else
' переход к следующей ячейке диапазона
Cells(ArrR(1, j + 1), ArrR(2, j + 1)).Select
End If
End If
Next j
End With
End If
End Sub
Add such a solution: the filling code may be used not only on one sheet. The launch can be arranged when any sheet is activated. Another is the possibility of returning from the last cell to the beginning of the range. It will be possible to clean up memory (e.g. when the book is closed):Set op = Nothing
