使用简单的命令(无循环)使用 VBA 从非连续范围的联合中获取值到数组中 [英] Get values from union of non-contiguous ranges into array with VBA with a simple command (no loops)

问题描述

我有以下(从表面上看，很简单)任务:

I have the following (on the surface of it, simple) task:

使用 VBA 将电子表格中多列的值复制到二维数组中.

Copy the values from a number of columns on a spreadsheet into a 2D array using VBA.

为了让生活更有趣，列不相邻，但它们的长度相同.显然可以通过依次循环每个元素来做到这一点，但这似乎很不雅观.我希望有一个更紧凑的解决方案 - 但我很难找到它.

To make life more interesting, the columns are not adjacent, but they are all of the same length. Obviously one could do this by looping over every element in turn, but that seems very inelegant. I am hoping there is a more compact solution - but I struggle to find it.

这里有一些我认为是简单方法"的尝试 - 为简单起见，我将范围设为 A1:A5, D1:D5 - 两个范围内共有 10 个单元格.

Here are some attempts of what I would consider "a simple approach" - for simplicity, I am putting the range as A1:A5, D1:D5 - a total of 10 cells in two ranges.

Private Sub testIt()
  Dim r1, r2, ra, rd, rad
  Dim valString, valUnion, valBlock
  Set r1 = Range("A1:A5")
  Set r2 = Range("D1:D5")
  valString = Range("A1:A5,D1:D5").Value
  valUnion = Union(r1, r2).Value
  valBlock = Range("A1:D5").Value
End Sub

当我查看这些变量中的每一个时，前两个有维度 (1 To 5, 1 To 1) 而最后一个有 (1 To 5, 1 To 4).我原以为前两个会得到 (1 To 5, 1 To 2) ，但事实并非如此.

When I look at each of these variables, the first two have dimension (1 To 5, 1 To 1) while the last one has (1 To 5, 1 To 4). I was expecting to get (1 To 5, 1 To 2) for the first two, but that was not the case.

如果我当时可以遍历一列数据，并将一列中的所有值分配给数组中的一列，我会很高兴 - 但我也无法弄清楚如何做到这一点.类似的东西

I would be happy if I could loop over the data one column at the time, and assign all the values in one column to one column in the array - but I could not figure out how to do that either. Something like

cNames = Array("A", "D")
ci = 1
For Each c in columnNames
  vals( , ci) = Range(c & "1:" & c & "5").Value
  ci = ci + 1
Next c  

但这不是正确的语法.我想得到的结果是

But that's not the right syntax. The result I want to get would be achieved with

cNames = Array("A", "D")
ci = 1
For Each c in columnNames
  For ri = 1 To 5
    vals(ri , ci) = Range(c & "1").offset(ri-1,0).Value
  Next ri
  ci = ci + 1
Next c  

但是这很丑陋.所以这是我的问题:

But that's pretty ugly. So here is my question:

是否可以将复合范围"(多个非连续块)的值放入数组中 - 一次全部或一次列?如果是这样，我该怎么做?

Is it possible to get the values of a "composite range" (multiple non-contiguous blocks) into an array - either all at once, or a columns at a time? If so, how do I do it?

对于额外的奖励积分 - 谁能解释为什么 testIt() 中返回的数组的尺寸是 Base 1，而我的 VBA 设置为 Option Base 0?换句话说 - 为什么它们不是 (0 To 4, 0 To 0)?这只是微软方面的又一矛盾吗?

For extra bonus points - can anyone explain why the arrays returned in testIt() are dimensioned Base 1, whereas my VBA is set to Option Base 0? In other words - why are they not (0 To 4, 0 To 0)? Is this just one more inconsistency on the part of Microsoft?

推荐答案

如果 rng 中的每个区域具有相同的行数，那么这应该可以工作.

Provided each area in rng has the same number of rows then this should work.

Function ToArray(rng) As Variant()
    Dim arr() As Variant, r As Long, nr As Long
    Dim ar As Range, c As Range, cnum As Long, rnum As Long
    Dim col As Range

    nr = rng.Areas(1).Rows.Count
    ReDim arr(1 To nr, 1 To rng.Cells.Count / nr)
    cnum = 0
    For Each ar In rng.Areas
        For Each col In ar.Columns
        cnum = cnum + 1
        rnum = 1
        For Each c In col.Cells
            arr(rnum, cnum) = c.Value
            rnum = rnum + 1 'EDIT: added missing line...
        Next c
        Next col
    Next ar

    ToArray = arr
End Function

用法:

Dim arr
arr = ToArray(Activesheet.Range("A1:A5,D1:D5"))
Debug.Print UBound(arr,1), UBound(arr,2)

至于为什么 rng.Value 中的数组从 1 开始而不是从 0 开始，我猜是因为这比如果它更容易映射到工作表上的实际行/列号是基于零的.Option Base x 设置被忽略

As for why array from rng.Value are 1-based instead of zero-based, I'd guess it's because that maps more readily to actual row/column numbers on the worksheet than if it were zero-based. The Option Base x setting is ignored

这篇关于使用简单的命令(无循环)使用 VBA 从非连续范围的联合中获取值到数组中的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！