Pasting a 2D array in a named range that is not rectangular-CodePudding

I'm trying to paste part of a 2D array into a range name than is a triangle, without looping over the lines and columns because it's too time consuming:

Here is a example:

Sub test2()
    Dim arr() As Double
    ReDim arr(1 To 4, 1 To 4)
    For i = 1 To 4
        For j = 1 To 4
            arr(i, j) = i   j
        Next j
    Next i
    
    'Worksheets("test").Range("A1:d4") = arr
     Worksheets("test").Range("TEST_TRIANGLE") = arr
End Sub

Unfortunately, the code doesn't do what I want : it actually fill the triangle only with the 1 column of the array

This is what I get

Whereas if I comment the last line and uncomment the one before:

This is what I get

The content of the triangle is correct, but unfortunately I also write in parts of the sheet that are filled with something else.

Does anybody know how I can achieve what I want ? Thanks in advance

CodePudding user response：

First the results. I have a sheet with formulas, and I am overwriting a select non-rectangular area. The named range "TRIG" consists in the gray shaded cells.

In VBA, the range object contains several Range().Areas which is a list of sub-ranges each rectangular in shape. So I decided to go through each one, find out where they are located relative to the named range (two offsets i1 and j1 calculated below).

The loop through the elements of each sub-range and set the value.

Public Sub TestTrig()

    Dim arr() As Variant, x As Variant
    Dim i As Long, j As Long
    Dim i1 As Long, j1 As Long
    
    Dim r As Range, ra As Range
    Set r = Sheets("Sheet1").Range("TRIG")
    
    For Each ra In r.Areas
        i1 = ra.Row - r.Row
        j1 = ra.Column - r.Column
        If ra.Rows.Count > 1 Or ra.Columns.Count > 1 Then
            arr = ra.Value
            For i = LBound(arr, 1) To UBound(arr, 1)
                For j = LBound(arr, 2) To UBound(arr, 2)
                    arr(i, j) = 4 * (i - 1   i1)   j   j1
                Next j
            Next i
            ra.Value = arr
        Else
            x = ra.Value
            x = 4 * (i1)   j1   1
            ra.Value = x
        End If
    Next
    
   

End Sub

Special care must be taken when only 1 cell is in the range, as the .Value is not an array but a scalar value. I used a variable x for this case.

CodePudding user response：

You could try going about it a different way, if you are looping the segments of the triangle in the first place, you can build a segment and stack them with a vertical origin. This generates, without overtyping, a triangle, with the cells A1-A4 and A1-D1 being the height and base. You can play about to the way it builds, but building it from the top or bottom. q is just to put something in the array.

Sub tri()

Const arrayNum As Integer = 4

Dim arrSeg() As Double

For i = 1 To arrayNum
    
    ReDim arrSeg(1 To arrayNum - i   1)

    For l = 1 To arrayNum - i   1
    
        arrSeg(l) = q
        q = q   1
        
    Next l

    Range("a1").Offset(0, i - 1).Resize(UBound(arrSeg), 1).Value = Application.Transpose(arrSeg)
    
Next i

End Sub

CodePudding user response：

Slice the existing array arr row wise via Application.Index(arr, i, 0) and write the slices to sheet by resizing the receiving target rows at the same time:

Dim i As Long, ii As Long
ii = UBound(arr)
For i = LBound(arr) To ii
    Sheet1.Range("A1").Offset(i - 1).Resize(1, ii - i   1) = Application.Index(arr, i, 0)
Next