Как преобразовать массив Variant в Range?

Question

У меня есть двумерный массив типа Variant. Размер и значения, которые заполняют массив, генерируются на основе данных в рабочей таблице. Для этого массива требуется дальнейшая обработка, основной из которых является интерполяция нескольких значений. Я использую эту функцию интерполяции (я знаю об эквивалентных функциях Excel, но был сделан выбор в пользу их использования). Проблема у меня заключается в том, что для функции интерполяции требуется объект Range.

Я уже пытался изменить функцию для использования аргумента Variant (r as Variant). Следующая строка nR = r.Rows.Count может быть заменена на nR = Ubound(r). Хотя это работает, я также хотел бы использовать эту функцию нормально на любом рабочем листе и никоим образом не изменять ее.

Sub DTOP()
    Dim term_ref() As Variant
    ' snip '
    ReDim term_ref(1 To zeroRange.count, 1 To 2)

    ' values added to term_ref '

    ' need to interpolate x1 for calculated y1 '
    x1 = Common.Linterp(term_ref, y1) 
End Sub

Функция интерполяции

Function Linterp(r As Range, x As Double) As Double
    Dim lR As Long, l1 As Long, l2 As Long
    Dim nR As Long

    nR = r.Rows.Count
    ' snipped for brevity ' 
End Function

Как мне преобразовать мой вариантный массив в памяти в Range, чтобы его можно было использовать для функции интерполяции? (без вывода на рабочий лист)

Ответ

Короче говоря, ответ - ты не можешь. Объект Range должен ссылаться на лист.

Измененная интерполяционная функция проверяет TypeName аргумента и соответственно устанавливает значение nR. Не самое красивое решение.

Как примечание, функция VarType оказалась бесполезной в этой ситуации, поскольку и VarType(Variant()), и VarType(Range) вернули одно и то же значение (т.е. vbArray) и не могли использоваться для устранения неоднозначности массива из диапазона

Function Linterp(r As Variant, x As Variant) As Double
    Dim lR As Long, l1 As Long, l2 As Long
    Dim nR As Long

    Dim inputType As String
    inputType = TypeName(r)

    ' Update based on comment from jtolle      
    If TypeOf r Is Range Then
        nR = r.Rows.Count
    Else
        nR = UBound(r) - LBound(r) 'r.Rows.Count
    End If
    ' ....
 End Function 

Answer 1

AFAIK, вы не можете создать объект Range, который каким-либо образом не ссылается на местоположение листа в вашей книге. Это может быть что-то динамическое, например, функция Named = OFFSET (), но она должна где-то привязываться к рабочему листу.

Почему бы не изменить функцию интерполяции? Сохраняйте подпись Linterp как есть, но превращайте ее в обертку для функции, которая интерполирует массив.

Примерно так:

Function Linterp(rng As Range, x As Double) As Double
' R is a two-column range containing known x, known y
' This is now just a wrapper function, extracting the range values into a variant
    Linterp = ArrayInterp(rng.Value, x)

End Function

Function ArrayInterp(r As Variant, x As Double) As Double

Dim lR As Long
Dim l1 As Long, l2 As Long
Dim nR As Long

    nR = UBound(r) ' assumes arrays are all 1-based

    If nR = 1 Then
        ' code as given would return 0, better would be to either return
        ' the only y-value we have (assuming it applies for all x values)
        ' or perhaps to raise an error.
        ArrayInterp = r(1, 2)
        Exit Function
    End If

    If x < r(1, 1) Then ' x < xmin, extrapolate'
        l1 = 1
        l2 = 2
    ElseIf x > r(nR, 2) Then ' x > xmax, extrapolate'
        l2 = nR
        l1 = l2 - 1
    Else
        ' a binary search might be better here if the arrays are large'
        For lR = 1 To nR
            If r(lR, 1) = x Then ' no need to interpolate if x is a point in the array'
                ArrayInterp = r(lR, 2)
                Exit Function
            ElseIf r(lR, 2) > x Then ' x is between tabulated values, interpolate'
                l2 = lR
                l1 = lR - 1
                Exit For
            End If
        Next
    End If

    ArrayInterp = r(l1, 2) _
           + (r(l2, 2) - r(l1, 2)) _
           * (x - r(l1, 1)) _
           / (r(l2, 1) - r(l1, 1))

End Function

Answer 2

вот функция для создания диапазона на новом листе.Вы можете изменить эту функцию, добавив другой параметр диапазона, чтобы обеспечить начальную точку для диапазона ячеек, в котором будет храниться ваш массив.

Сначала введите код, как есть, и пройдитесь по Sub Test (), используя отладчик, чтобы увидетьэто может сделать для вас ...

Function Array2Range(MyArray() As Variant) As Range
Dim X As Integer, Y As Integer
Dim Idx As Integer, Jdx As Integer
Dim TmpSht As Worksheet, TmpRng As Range, PrevRng As Range

    X = UBound(MyArray, 1) - LBound(MyArray, 1)
    Y = UBound(MyArray, 2) - LBound(MyArray, 2)

    Set PrevRng = Selection
    Set TmpSht = ActiveWorkbook.Worksheets.Add
    Set TmpRng = TmpSht.[A1]


    For Idx = 0 To X
        For Jdx = 0 To Y
            TmpRng(Idx + 1, Jdx + 1) = MyArray(LBound(MyArray, 1) + Idx, LBound(MyArray, 2) + Jdx)
        Next Jdx
    Next Idx

    Set Array2Range = TmpRng.CurrentRegion
    PrevRng.Worksheet.Activate

End Function

Sub Test()
Dim MyR As Range
Dim MyArr(3, 3) As Variant

MyArr(0, 0) = "'000"
MyArr(0, 1) = "'0-1" ' demo correct row/column
MyArr(1, 0) = "'1-0" ' demo correct row/column
MyArr(1, 1) = 111
MyArr(2, 2) = 222
MyArr(3, 3) = 333

Set MyR = Array2Range(MyArr) ' to range
Range2Array MyR, MyOther     ' and back

End Sub

РЕДАКТИРОВАТЬ ============= исправлен sub test () для демонстрационного преобразования обратно в массив и добавлен быстрый и грязный фрагмент кодапреобразовать обратный диапазон в массив

Sub Range2Array(MyRange As Range, ByRef MyArr() As Variant)
Dim X As Integer, Y As Integer
Dim Idx As Integer, Jdx As Integer
Dim MyArray() As Variant, PrevRng As Range

    X = MyRange.CurrentRegion.Rows.Count - 1
    Y = MyRange.CurrentRegion.Columns.Count - 1
    ReDim MyArr(X, Y)

    For Idx = 0 To X
        For Jdx = 0 To Y
            MyArr(Idx, Jdx) = MyRange(Idx + 1, Jdx + 1)
        Next Jdx
    Next Idx
    MyRange.Worksheet.Delete

End Sub