Очистка массива

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 строк, которые, как мы надеемся, уменьшатся до числа, близкого к 20000 или 30 000 строк, после обработки.

Я предполагаю, что повторение каждой записи будет очень трудоемким.

Есть ли другой способ, который быстрее?

Answer 1

Я не знаю ни одного другого способа в VBA, кроме как перебирать массив и писать другой массив/список.

Что делает его более сложным, так это то, что ваш массив выглядит двумерным, а VBA позволит вам только переделать последнее измерение. Из внешнего вида ваших данных вы хотите переделать первое измерение по мере того, как вы перебираете массив.

Есть несколько решений:

1. итерацию данных дважды - один раз, чтобы получить размер массива (и, вероятно, для хранения соответствующих номеров строк) и второй раз для передачи исходных данных в ваши новые данные ,

2. Повторяйте один раз и просто измените размеры (т.е. строка последней).

3. Используйте массив массивов, так что каждый массив имеет только одно измерение).

4. Используйте 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 выполнения сценариев чисто для чтения файла):

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 довольно изумительный.