从多列返回非空白

Question

我一直试图将包含多列的整个范围中的非空白单元格提取到一列中的列表中，但没有任何运气。 我有一个适用于单个列的数组，但是当我扩展其范围时，它会失败。

Here's a sample range

非常感谢任何帮助！

干杯，

弗朗西斯

Answer 1

以下是一个例子：

Sub Test()
Dim c As Variant, NB As New Collection
For Each c In [A1:D10] 'Whatever range to check
    If c <> "" Then NB.Add c
Next c
For Each c In NB
    Debug.Print c 'Do whatever you want with this list here
Next c
End Sub

使用[A1:D10]

输入

调试窗口中的输出：

使用变体数组替代 - 对于更大范围更快，代码更不优雅imo：

Sub Test()
Dim r(), s As New Collection, x, y, z
r = Range("A1:D10")
For x = 1 To UBound(r, 1)
    For y = 1 To UBound(r, 2)
        If r(x, y) <> "" Then s.Add r(x, y)
    Next y
Next x
For Each z In s
    Debug.Print z 'Do whatever you want with this list here
Next z
End Sub

修改

您可以将其直接放在数组中：

Redim Preserve可能会出现大范围的性能问题，这就是为什么最好使用IMO集合 - 但它可能会对您的代码产生影响。

http://www.vbforums.com/showthread.php?450819-Is-it-bad-or-slow-to-use-Redim-Preserve-many-many-many-times

Sub Test()
Dim c, arr(), count
count = 0
For Each c In [A1:D10] 'Whatever range to check
    If c <> "" Then
        ReDim Preserve arr(count + 1)
        arr(count) = c
        count = count + 1
    End If
Next c
For x = 0 To UBound(arr)
    Debug.Print arr(x)
Next x
End Sub

您也可以将集合放入数组中并打印出结果。

Sub Test()
Dim c As Variant, NB As New Collection
For Each c In [A1:D10] 'Whatever range to check
    If c <> "" Then NB.Add c
Next c
Dim arr(), x
ReDim arr(NB.Count)
x = 0
For Each c In NB
    arr(x) = c
    x = x + 1
Next c
For x = 0 To UBound(arr)
    Debug.Print arr(x)
Next x
End Sub

Answer 2

如果有人在寻找配方解决方案，下面的内容对我也有用：

=IFERROR(INDIRECT("SHEET1!"&TEXT(SMALL(IF(SHEET1!$A$33:$H$42<>"",ROW(SHEET1!$A$33:$H$42)*10^4+COLUMN(SHEET1!$A$33:$H$42)),ROWS($A$1:A1)),"R0000C0000"),0),"")

然后按Ctrl + Shift + Enter