Есть ли способ получить индекс активного диапазона выбора?

Question

Я создаю код, который будет проходить через список чисел и интерполировать диапазон «новых X». То, что я пытаюсь сделать, это вместо того, чтобы изменять код для циклического перебора другого диапазона. я хотел бы выбрать диапазон ячеек в электронной таблице и затем вывести новые данные рядом с существующими данными.

Мне было интересно, есть ли способ индексировать выбранный диапазон, чтобы я мог использовать его для своих циклов.

Private Sub Test_Click()
    Dim rng As Integer, num As Integer
    Dim xLower As Double, yLower As Double, xNew As Double
    Dim xHigher As Double, yHigher As Double, yNew As Double

    xNew = 0
    For num = 1 To 28
        xNew = xNew + 0.01
        xLower = 0
        yLower = 0

        xHigher = 1.26
        yHigher = 0

        For rng = 2 To 108
            If xNew - ActiveSheet.Cells(rng, 1).Value < xNew - xLower And ActiveSheet.Cells(rng, 1) < xNew Then
                xLower = ActiveSheet.Cells(rng, 1).Value
                yLower = ActiveSheet.Cells(rng, 3).Value

            ElseIf xNew + ActiveSheet.Cells(rng, 1).Value < xNew + xHigher And ActiveSheet.Cells(rng, 1) > xNew Then
                xHigher = ActiveSheet.Cells(rng, 1).Value
                yHigher = ActiveSheet.Cells(rng, 3).Value
            End If
        Next rng

        yNew = (xNew - xLower) / (xHigher - xLower) * (yHigher - yLower) + yLower

        Cells(num, 7) = yNew
        Cells(num, 6) = xNew
    Next num

End Sub

Answer 1

Установите выделение как диапазон для обхода и определите расположение верхней левой ячейки в диапазоне, например:

dim ulRow as long, ulCol as long, selrng as range
ulRow = selection.row
ulCol = selection.column
Set selrng = application.selection

Затем вы можете выполнить цикл с этой информацией или выводить данные относительно этого диапазона, например,

for each cl in selrng
    if isempty(cl) then cells(ulRow,ulCol+1).value = "moo"
next cl

---

Edit1:

Добавление таким образом, чтобы найти строку / столбец последней ячейки в случае, если это необходимо:

With selrng
    lr = .row + .rows.count - 1
    lc = .column + .columns.count - 1
end with

Затем вы можете выполнить цикл как:

For i = ulRow to lr
    if cells(i,lc).value <> 0 then cells(i,lc+1).value = "moo"
next i