使用UDF Excel 2007 VBA的2-DRange->数组-> 2D-Range

Question

I'm trying to create a UDF that has 2D-Range as the input, resizes it, adjusts one of its values and has new 2D-Range as output. It is important to have Range as output since ranges will be used it other functions. Unfortunately other function do not recognize new 2D-Range as Range.

---

Function Func1(Structure As Range) As Variant

i = 3
Dim temp1 As Range
Dim temp2 As Range
Set temp1 = Structure.Resize(i, 3)

Dim arr1()
ReDim arr1(1 To i, 1 To 3)
arr1 = temp1
arr1(2, 2) = 100

Func1 = arr1

End Function

---

Function Func2(InputArray)

Func2 = InputArray.Rows.Count

End Function

---

So - function Func2(Func1(Structure)) does not work. it should give out number of rows in new 2D-Range.

Will anyone help please?

I'm using Excel 2007

Answer 1

Tim Williams and KazJaw are correct, you might consider using another approach. However, I have a possible solution and the code is below. Note that this approach will be slow and you must be strict with your exception handling.

Option Explicit

Function Func1(Structure As Range) As Range
    Dim TempWs As Worksheet 'Needed to create a range
    Dim temp1 As Range      'Resized input range
    Dim temp2 As Range      'Why is this needed?
    Dim arr1 As Range       'Range to be returned
    Dim i As Integer        '?

    'Add a temporary worksheet to the end
    Set TempWs = ThisWorkbook.Worksheets.Add(, _
        ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
    i = 3

    Set temp1 = Structure.Resize(i, 3)

    With TempWs

        'Set the temporary range and get the existing values
        Set arr1 = TempWs.Range(.Cells(1, 1), .Cells(i, 3))
    End With

    arr1.Value = temp1.Value

    arr1(2, 2) = 100

    Set Func1 = arr1

    'clean up
    Set temp1 = Nothing
    Set temp2 = Nothing
    Set arr1 = Nothing
    Set TempWs = Nothing

End Function


Sub test()
    Dim GetRange As Range
    Set GetRange = Func1(Range("A1:C3"))
    ThisWorkbook.Worksheets(1).Range("D1:F3").Value = GetRange.Value

    'You need to delete the temporary worksheet
    Application.DisplayAlerts = False
    GetRange.Worksheet.Delete
    Application.DisplayAlerts = True
    Set GetRange = Nothing
End Sub