Question

我在VBA中有一个非常大的数组，其中包含许多我想删除的0值。像这样：

A    B    C    12345
D    E    F    848349
G    H    I    0
J    K    L    0
M    N    O    0
P    Q    R    4352
S    T    U    0
V    W    X    0

我希望能够快速/轻松地删除此数组中第4列中为零的所有行，从而产生如下结果：

A    B    C    12345
D    E    F    848349
P    Q    R    4352

这个数组有大约100,000行，希望在处理后可以下降到接近20,000或30,000行的数字。

我认为迭代每个条目都会非常费时。

还有另一种方式更快吗？

Answer 1

我不知道VBA中的任何其他方式比循环数组并编写另一个数组/列表。

更难的是你的阵列看起来是二维的，而VBA只允许你重新划分最后一个维度。从您的数据外观来看，您希望在迭代数组时重新开始第一维。

有几种解决方案：

迭代您的数据两次 - 一次获取数组大小（可能存储相关的行号），第二次将原始数据传输到新数据中。
迭代一次，然后反转你的尺寸（即排在最后）。
使用数组数组，以便每个数组只有一个维度。
使用不需要标注尺寸的Collection - 这是我的首选选项。

选项4看起来像这样（我假设您的数组基于零）：

Dim resultList As Collection
Dim r As Long

Set resultList = New Collection
For r = 0 To UBound(raw, 1)
    If raw(r, 3) <> 0 Then
        resultList.Add Array(raw(r, 0), raw(r, 1), raw(r, 2), raw(r, 3))
    End If
Next

如果你必须写一个新阵列，那么这里是选项1的一个例子：

Dim rowList As Collection
Dim result() As Variant
Dim r As Long
Dim c As Long
Dim v As Variant

Set rowList = New Collection
For r = 0 To UBound(raw, 1)
    If raw(r, 3) <> 0 Then
        rowList.Add r
    End If
Next

ReDim result(rowList.Count - 1, 3) As Variant
c = 0
For Each v In rowList
    result(c, 0) = raw(v, 0)
    result(c, 1) = raw(v, 1)
    result(c, 2) = raw(v, 2)
    result(c, 3) = raw(v, 3)
    c = c + 1
Next

Answer 2

好的，它都是片外的，所以所有阵列都是零基础的。为了测试这个设置，我创建了一个包含四列的工作表，根据您的数据和第四列中的随机数。我将其保存到文本文件（TestFile.txt），然后将其读入以获得基于零的数组（当您将它们放入数组时，Excel范围是从1开始的）。我将150000行保存到文本文件中以正确地强调例程。是的，我有一个SSD，这会影响2s的运行时间，但我认为我仍然希望它能在旋转的硬盘上运行<10s。

无论如何，这里是代码（需要VBA引用Microsoft Scripting Runtime纯粹是为了在文件中读取）：

Public Function ReturnFilteredArray(arrSource As Variant, _
                                strValueToFilterOut As String) As Variant
Dim arrDestination      As Variant
Dim lngSrcCounter       As Long
Dim lngDestCounter      As Long

ReDim arrDestination(UBound(arrSource, 1) + 1, UBound(arrSource, 2) + 1)

lngDestCounter = 1
For lngSrcCounter = LBound(arrSource, 1) To UBound(arrSource, 1)
    ' Assuming the array dimensions are (100000, 3)
    If CStr(arrSource(lngSrcCounter, 3)) <> strValueToFilterOut Then
        ' Hit an element we want to include
        arrDestination(lngDestCounter, 1) = arrSource(lngSrcCounter, 0)
        arrDestination(lngDestCounter, 2) = arrSource(lngSrcCounter, 1)
        arrDestination(lngDestCounter, 3) = arrSource(lngSrcCounter, 2)
        arrDestination(lngDestCounter, 4) = arrSource(lngSrcCounter, 3)

        lngDestCounter = lngDestCounter + 1
    End If
Next

ReturnFilteredArray = arrDestination
End Function

Sub TestRun()
Dim fso As FileSystemObject
Dim txs As TextStream
Dim arr As Variant
Dim arr2 As Variant
Dim lngCounter As Long

Debug.Print Now()
Set fso = New FileSystemObject
Set txs = fso.OpenTextFile("E:\Users\Thingy\Desktop\TestFile.txt", ForReading)
arr = Split(txs.ReadAll, vbNewLine)
ReDim arr2(UBound(arr), 3)

For lngCounter = 0 To UBound(arr) - 1
    arr2(lngCounter, 0) = Split(arr(lngCounter), vbTab)(0)
    arr2(lngCounter, 1) = Split(arr(lngCounter), vbTab)(1)
    arr2(lngCounter, 2) = Split(arr(lngCounter), vbTab)(2)
    arr2(lngCounter, 3) = Split(arr(lngCounter), vbTab)(3)
Next

arr2 = ReturnFilteredArray(arr2, "0")
Range("L2").Resize(UBound(arr2, 1), 5) = arr2

Debug.Print Now()
End Sub

其中有许多假设，尤其是尺寸。注意arrDestination和arrSource之间的第二个维度计数器的差异。这与Excel是基于1的正常数组是基于0的。

另外，当我写出数组时，我需要将第二个维度提升到5，以便将所有数组输出到工作表。我无法修剪空元素，因为ReDim Preserve仅适用于最上面的维度（列），而且它是在此处更改的第一个维度（行）。

Anywho，这应该是一个提醒，尽管它有缺点Excel非常棒。

清理阵列

2 个答案: