如何将Variant数组转换为Range？
我有一个Varianttypes的二维数组。 填充数组的大小和值是基于工作表中的数据生成的。 这个arrays需要进一步的处理，主要是几个值的插值。 我正在使用这个插值函数 （我知道有关excel的等价函数，但是没有使用它们的deviseselect）。 我遇到的问题是内插函数需要一个Range对象。
我已经尝试修改函数来使用Variant（ r as Variant ）参数。 以下行nR = r.Rows.Count可以用nR = Ubound(r)replace。 虽然这个工作，我也想通常在任何工作表中使用此function，不以任何方式更改function。
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对象必须引用一个工作表。
改变的插值函数检查参数的TypeName并相应地设置nR的值。 不是最漂亮的解决scheme。
注意，在这种情况下， VarType函数被certificate是无用的，因为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
AFAIK，你不能创build一个不以某种方式引用工作表位置工作簿的Range对象。 它可以是dynamic的，例如，喜欢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
这里是一个函数来创build一个新的工作表范围。 您可以通过添加另一个范围参数来修改此函数，以提供单元格范围的起始点来保存您的数组。
首先把代码放在代码中，然后使用debugging器通过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
编辑============= ammend子testing（）演示转换回数组，并添加了快速和脏的代码块转换回数组的范围
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