vba 如何将 Variant 数组转换为 Range？

How to convert a Variant array to a Range?

提问by Ahmad

I have a 2D array of type Variant. The size and values that populate the array are generated based on data within a worksheet. Further processing is required on this array, the primary being the interpolation of several values. I am using this interpolation function(I know about excel equivalent functions but a design choice was made not to use them) . The problem I am having is the that the Interpolation function requires a Range object.

我有一个类型为 的二维数组Variant。填充数组的大小和值是根据工作表中的数据生成的。这个数组需要进一步处理，主要是几个值的插值。我正在使用这个插值函数（我知道 excel 等效函数，但设计选择不使用它们）。我遇到的问题是插值函数需要一个 Range 对象。

I have already tried modifying the function to use a Variant (r as Variant) argument. The following line nR = r.Rows.Countcan be replaced with nR = Ubound(r). While this works, I would also like to use this function normally within any worksheet and not change the function in any way.

我已经尝试修改函数以使用 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

Interpolation Function

插值函数

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

How do I convert my in-memory variant array to a Range so that it can be used for the interpolate function? (without outputting to a WorkSheet)

如何将内存中的变量数组转换为 Range 以便它可用于插值函数？（不输出到工作表）

Answer

回答

In short, the answer is you can't. A Range object must reference a worksheet.

简而言之，答案是你不能。Range 对象必须引用工作表。

The changed interpolation function checks the TypeNameof the argument and sets the value of nRaccordingly. Not the prettiest solution.

更改后的插值函数检查TypeName参数的 并相应地设置 的值nR。不是最漂亮的解决方案。

As a note, the VarTypefunction proved useless in this situation since both VarType(Variant())and VarType(Range)returned the same value (i.e vbArray) and could not be used to disambiguate an array from a range

作为一个说明，该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 

采纳答案by Mike Woodhouse

AFAIK, you can't create a Range object that doesn't in some way reference a worksheet location your workbook. It can be something dynamic, liked a Named =OFFSET() function, for example, but it has to tie back to a worksheet somewhere.

AFAIK，您无法创建不以某种方式引用您的工作簿的工作表位置的 Range 对象。它可以是动态的，例如 Named =OFFSET() 函数，但它必须与某个工作表相关联。

Why not change the interpolation function? Keep your Linterp signature as is, but make it into a wrapper for a function that interpolates on an array.

为什么不改变插值函数？保持你的 Linterp 签名不变，但将它变成一个对数组进行插值的函数的包装器。

Something like this:

像这样的东西：

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

回答by MikeD

here's a function to create a range in a new sheet. You can modify this function by adding another range parameter to provide the starting point for the cell range to hold your array.

这是在新工作表中创建范围的函数。您可以通过添加另一个范围参数来修改此函数，以提供用于保存数组的单元格范围的起点。

Put in the code as is at first and walk thru Sub Test() using debugger to see what it can do for you ...

首先按原样输入代码，然后使用调试器遍历 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

EDIT ============= ammended sub test() to demo conversion back into array and added quick & dirty piece of code to convert back range into array

编辑 ============== 修正 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