首页 > 解决方案 > 2D VBA 数组的移位元素

问题描述

全部 -

我想知道是否有一种有效的方法来“移动”二维数组的元素。实际上,我所拥有的是三角形数据,保存在 VBA 数组中(nxm,其中 n <= m):

      0 1 2 3 4 5
  ----------------
  0 | A B C D E F
  1 | G H I J
  2 | K L

我想将此数组“重组”为:

      0 1 2 3 4 5
  ----------------
  0 | A B C D E F
  1 |     G H I J
  2 |         K L

数组中的空白值实际上是空字符串(“”)。我想有一些循环我可以用一些计算成本来执行这个,但我想知道是否有一种有效的方法来在 VBA 中“移动”子集......

标签: arraysvba

解决方案


As @TimWilliams commented correctly, you won't do it without any loops. - A possible approach, however reducing loops would be to

  • write the initial array (named e.g. v) row wise to an empty target range (applying individual offsets you can calculate before) and eventually
  • assign them back as so called data field array.

The following example code should give you an idea. - Little draw back: in any case you get the array back as 1-based array.

        '~~> assign initial (variant) array v as in OP
        '...
        '~~> calculate column offsets per array row, e.g. {0,2,4}
        '...

        '~~> shift array rows and write them to any empty target area
        Dim startCell As Range: Set startCell = Sheet1.Range("X1")
        Dim i As Long, j As Long, tmp As Variant
        For i = 1 To UBound(v)
            '~~> get individual column offset per row, e.g. {0,2,4}
            j = Array(0, 2, 4)(i - 1)
            '~~> write next row to target range
            startCell.Offset(i, j).Resize(1, UBound(v, 2)) = Application.Index(v, i, 0)
        Next i
        '~~> get rearranged 1-based 2-dim datafield array
        v = startCell.Offset(1).Resize(UBound(v), UBound(v, 2))

If you shift elements within a greater array, you could write the entire array to the target and overwrite only rows you need rearranged (considering to clear these single row ranges before:-)


推荐阅读