清理一个数组
我在VBA中有一个非常大的数组，其中包含很多我想要删除的值。 像这样的东西：
ABC 12345 DEF 848349 GHI 0 JKL 0 MNO 0 PQR 4352 STU 0 VWX 0
我希望能够快速/容易地去除这个数组中第四列有零的所有行，导致如下所示：
ABC 12345 DEF 848349 PQR 4352
这个数组有10万左右的行，有希望下降到接近2万或3万行，而不是处理后。
我认为迭代每个条目将certificate非常耗时。
还有另外一种方法更快吗？
我不知道任何其他方式在VBA比遍历数组，并写入另一个数组/列表。
更棘手的是，你的数组看起来是二维的，而VBA将只允许你重写最后一个维度。 从数据的外观来看，当你迭代你的数组时，你会想要重新初始化第一维。
有几个解决scheme：
-
迭代你的数据两次 – 一次获得数组大小（并可能存储相关的行号），第二次将原始数据传输到新的数据。
-
迭代一次，只是扭转你的维度（即行是最后一个）。
-
使用数组的数组，以便每个数组只有一个维度）。
-
使用一个不需要标注的
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
好的，这些都是离谱的，所以所有的数组都是从零开始的。 为了testing这个设置，我创build了一个包含四列的工作表，根据您的数据和第四列中的随机数字。 我将它保存到一个文本文件（TestFile.txt）中，然后读取它以获得一个从零开始的数组（Excel范围是基于1的，当把它们放到一个数组中的时候）。 我保存了150000行到文本文件，以正确地强调例程。 是的，我有一个固态硬盘，这将影响2s的运行时间，但我仍然认为它可以在一个旋转硬盘上运行<10s。
无论如何，这里的代码（需要一个VBA引用微软脚本运行时纯粹读取文件）：
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只能在最上面的维（列）上工作，而且这是第一维（行）在这里发生了变化，所以我无法修剪掉空白的元素。
无论如何，这应该是一个提醒，尽pipeExcel的错误是相当惊人的。