How to convert a Variant array to Range?

I have a Variant type 2D array. The size and values ​​that fill the array are generated based on the data in the sheet. For this array, additional processing is required, the primary one is the interpolation of several values. I use this interpolation function (I know about the equivalent excel functions, but the design was not chosen for their use). The problem I am facing is that a Range object is required for the interpolation function.

I have already tried modifying the function to use the Variant argument ( r as Variant ). The next line nR = r.Rows.Count can be replaced with nR = Ubound(r) . Although this works, I would also like to use this function, as a rule, in any worksheet, and not change the function in any way.

 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 can I convert my array in memory to a range so that it can be used for the interpolation function? (without output to the worksheet)

Answer

In short, the answer is you cannot. The Range object must reference the worksheet.

The modified interpolation function checks the TypeName argument and sets the value nR accordingly. Not the most beautiful solution.

As a note, the VarType function VarType out to be 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 the array from the range

 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 
+4
source share
2 answers

AFAIK, you cannot create a Range object that somehow does not reference the location of your workbook. It may be something dynamic, for example, the Named = OFFSET () function, but it should be anchored somewhere to the worksheet.

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

Something like that:

 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 
+3
source

here is the function to create a range in a new sheet. You can change this function by adding another range parameter to provide the starting point of a range of cells for storing your array.

Paste the code as it is and go through Sub Test () using the debugger to see what it can do for you ...

 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 ============= fixed subtest () for demo conversion to array and added quick and dirty code snippet to convert back range to array

 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 
+1
source

Source: https://habr.com/ru/post/1315494/


All Articles