Insert vertical slices into array

问题

In a recent post I demonstrated how to use array arguments in the Application.Index() function (instead of single indices) to rearrange the current columns order in any direction (switch columns, omit/delete columns).

    Application.Index(data, {vertical rows array}, {horizontal columns array})

This approach doesn't need loops and allows to get any new column order defined just by listing the new column positions, in OP e.g. via

     Array(1, 4, 2)

in other words

the 1st column,
(the 3rd one omitted=deleted),
the remaining columns 4 and 2 in switched order*:

Sub DeleteAndSwitch()
'[1]get data
    Dim data: data = Sheet1.Range("A1:D4")
'[2]reorder columns via Array(1, 4, 2), i.e. get 1st column, 4th and 2nd column omitting the 3rd one
'   (evaluation gets all existing rows as vertical 2-dim array)
    data = Application.Index(data, Evaluate("row(1:" & UBound(data) & ")"), Array(1, 4, 2))
'[3]write to any target
    Sheet2.Range("A1").Resize(UBound(data), UBound(data, 2)) = data
End Sub

A related comment asked:

"I can slice a 2D array, I can eliminate column, reorder columns, but I cannot ►insert a column(s) slice in such an array... In fact, I can do it using iteration, but did you find a similar way to insert such a vertical slice?"

Methodical hints

As is at least frequently known, a given column (e.g. the 4th) can be sliced from an array (here e.g. data) via

    Column4Data = Application.Index(data, 0, 4)

resulting itself in a 1-based 2-dim "vertical" array.

It's not possible, however to assign a vertical slice to another one; the following code would raise a 1004 error (Application-defined or object-defined error):

Application.Index(data, 0, 4) = Application.Index(data, 0, 1)

Question

Is there any possibility to insert a column(s) slice in an array (without iteration)?

There does exist a possibility to arrange such column data in a temporary array of arrays ("jagged array") and to build a 2-dim array from this base.

In order not to overcharge this post I'll demonstrate this rather unknown approach as ►separate answer looking forward to any other or better approach.

Related link Some pecularities of the Application.Index() function

回答1:

Jagged array approach using Application.Index()

For the sake of completeness I show this approach in order to demonstrate a further and widely unknown possibility of the Application.Index() function.

By adding (transposed) slices to a temporary "Array of Arrays" first, it's possible to create a 2-dim array in a second step via double zero arguments using the following syntax (c.f. section [2]b):

    data = Application.Transpose(Application.Index(data, 0, 0))

Sub InsertSlices()
'Auth: https://stackoverflow.com/users/6460297/t-m
'[0]define extra array (or slice AND transpose from other data source)
    Dim Extra: Extra = Array(100, 200, 300, 400)   ' example data
'[1]get data
    Dim data: data = Tabelle7.Range("A1:D4")
'[2]a) rewrite data as 1-dim array of sliced column arrays
    data = Array(Extra, Slice(data, 1), Slice(data, 4), Slice(data, 2))
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'[2]b) rebuild as 2-dim array
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    data = Application.Transpose(Application.Index(data, 0, 0))
'[3]write to any target
    Tabelle7.Range("F1").Resize(UBound(data), UBound(data, 2)) = data
End Sub

Function Slice(DataArr, ByVal colNo As Long) As Variant()
'Purpose: return entire column data as 2-dim array and
'         transpose them here to get a "flat" 1-dim array of column data
With Application
    Slice = .Transpose(.Index(DataArr, 0, colNo))
End With
End Function

Caveat: The repeated transformation of data in two steps can be time consuming for larger data sets.

Workaround

Therefore I'd prefer the basic approach in the cited post via ►array arguments in the Application.Index() function, but by inserting a (e.g. temporary) column to the physical data range first and eventually by rearranging the columns including the newly added extra data (last position) at any new position (e.g. here on top).

Sub DelSwitchAndInsert()
'Auth: https://stackoverflow.com/users/6460297/t-m
'[0]add other array data as last column to existing range
    Sheet1.Range("E1:E4") = Application.Transpose(Array(1, 2, 3, 4))
'[1]get data
    Dim data: data = Tabelle7.Range("A1:E4")
'[2]reorder via Array(1, 4, 2), i.e. get 1st column, 4th and 2nd column omitting the 3rd one
    data = Application.Index(data, Evaluate("row(1:" & UBound(data) & ")"), Array(UBound(data, 2), 1, 4, 2))
'[3]write to any target
    Sheet2.Range("A1").Resize(UBound(data), UBound(data, 2)) = data
End Sub

Addendum to workaround in response to recent comments //Edit/2020-07-07

A flexible example following the workaround logic for insertion of vertical extra single-column data at any given "column" number could be as follows; I don't pretend this to be neither the best method nor the best way to code:

    InsCol data, extra, 3        ' insertion e.g. as new 3rd "column"

Sub InsertExtraData()
'Purpose:  insert a single-column array (2-dim, 1-based)
    '[0]define extra array (or slice AND transpose from other data source)
        Dim extra: extra = Application.Transpose(Array(100, 200, 300, 400))   ' example data
    '[1]get data (or existing 2-dim array)
        Dim data: data = Sheet1.Range("A1:D4")
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '[2]insert extra as >>3rd<< column
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        InsCol data, extra, 3
    '[3]write to any target
        Sheet2.Range("A1").Resize(UBound(data), UBound(data, 2)) = data
End Sub

Sub InsCol(data, extra, Optional ByVal colNo As Long = 1)
With Sheets.Add
    '[0]add data to temporary range
    .Range("B1").Resize(UBound(data), UBound(data, 2)) = data
    .Range("B1").Offset(0, UBound(data, 2)).Resize(UBound(extra) - LBound(extra) + 1, 1) = extra
    '[1]get data
        data = .Range("B1").Resize(UBound(data), UBound(data, 2) + 1)
    '[2]reorder via Array(5, 1, 2, 3, 4)
        data = Application.Index(data, Evaluate("row(1:" & UBound(data) & ")"), getColNums(data, colNo))
    '[3]delete temporary sheet
        Application.DisplayAlerts = False: .Delete
        Application.DisplayAlerts = True
End With
End Sub

Function getColNums(main, Optional ByVal colNo As Long = 1) As Variant()
    'c.f. : https://stackoverflow.com/questions/53727578/joining-two-arrays-in-vba/60082345#60082345
    'Purp.: return ordinal element counters of combined 0-based 1-dim arrays
    Dim i&, n&: n = UBound(main) + 1    ' +1 as one column, +1 from 0-based~>one-based
    ReDim tmp(0 To n - 1)               ' redim to augmented size (zero-based)
    If colNo > n Then colNo = n
    If colNo < 1 Then colNo = 1
    For i = 0 To colNo - 1: tmp(i) = i + 1: Next i
    tmp(colNo - 1) = n
    For i = colNo To UBound(tmp): tmp(i) = i: Next i
    getColNums = tmp        ' return combined elem counters,  e.g. Array(1,2, >>5<< ,3,4)
End Function

来源：https://stackoverflow.com/questions/62722676/insert-vertical-slices-into-array

标签

arrays

excel

vba

slice