Извлечение данных из таблицы в массив, затем перепечатка на новый лист - PullRequest
0 голосов
/ 04 февраля 2020

У меня очень тяжелая таблица Excel (примерно 65 000 строк и 7 столбцов), которую я хочу по частям извлекать на разные рабочие листы. Я запустил программу, и она, кажется, работает нормально, но она всегда останавливает повторное копирование в строке 1771, несмотря на то, что я не вижу явных ошибок в коде. Повторное копирование должно go по крайней мере до строки 3500. Если я удаляю оператор If и объединяю 2 для циклов в 1 для L oop, он все равно останавливается на строке 1771. Ограничены ли массивы с точки зрения хранения?

Sub extract_collar()

Dim myArray() As Variant
Dim myTable As ListObject
Dim cell As Range
Dim x As Long


Application.ScreenUpdating = False

Set myTable = ActiveWorkbook.Sheets("FullCarriers").ListObjects("CarrierTable")

For i = 1 To 2

    TempArray = myTable.DataBodyRange.Columns(i)

    myArray = Application.Transpose(TempArray)

    For x = LBound(myArray) To UBound(myArray)
        If Mid(myArray(x), 13, 2) = "01" Then
            ActiveWorkbook.Sheets("Collar").Cells(x + 1, i) = myArray(x)
        End If

    Next x

Next i

For i = 3 To 7

    TempArray = myTable.DataBodyRange.Columns(i)

    myArray = Application.Transpose(TempArray)

    For x = LBound(myArray) To UBound(myArray)
        ActiveWorkbook.Sheets("Collar").Cells(x + 1, i) = myArray(x)
    Next x

Next i

Application.ScreenUpdating = True

End Sub

Ответы [ 2 ]

0 голосов
/ 07 февраля 2020

Если я правильно понимаю:

Sub extract_collar()

    Dim inArray As Variant, outArray As Variant
    Dim myTable As ListObject
    Dim cell As Range
    Dim x As Long, i As Long, c As Long, cols As Long

    Set myTable = ActiveWorkbook.Sheets("FullCarriers").ListObjects("CarrierTable")

    inArray = myTable.DataBodyRange.Value 'get all the data
    ReDim outArray(1 To UBound(inArray, 1), 1 To cols) 'size the output array
    cols = UBound(inArray, 2)             'how many columns

    x = 0
    'loop over the data and check if we need the row
    For i = 1 To UBound(inArray, 1)
        If Mid(inArray(i, 1), 13, 2) = "01" Or Mid(inArray(i, 2), 13, 2) = "01" Then           
            x = x + 1 'increment "row" in output array
            'copy the row to the "out" array
            For c = 1 To cols 
                outArray(x, c) = inArray(i, c)
            Next c
        End If
    Next

    'dump the results to a worksheet
    If x > 0 Then
        ActiveWorkbook.Sheets("Collar").Range("A2").Resize(x, cols).Value = outArray
    End If

End Sub
0 голосов
/ 04 февраля 2020

Многочисленные источники, которые я обнаружил, предполагают, что размер массивов для кода VBA зависит от объема памяти в машине.

Было бы неплохо, если бы была функция Application.UseMoreMemory(), которую мы могли бы просто call: -)

Увы, я не знаю ни одного.

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

Следует помнить, что увеличение с 500 до 600 выглядит лишь как умеренное увеличение (хотя 20% само по себе достаточно), потому что вы делаете что в трех измерениях он почти удваивает требования к хранилищу.

Из памяти Excel 2007 использовал короткие целые числа (16 бит) для логического типа, поэтому, как минимум, ваш массив 5003 будет занимать около 250M (500x500x500x2).

Увеличение всех размеров до 600 даст вам 600x600x600x2 или около 432M.

Все в пределах доступного адресного пространства 2G что у вас, вероятно, есть в 32-разрядной машине (я не знаю, что Excel 2007 имел 64-разрядную версию), но эти вещи не малы, и вы должны разделить это адресное пространство с другими вещами.

Было бы интересно узнать, с какого момента вы начали получать ошибки.

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

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

Другая возможность - абстрагироваться от обработки битов так, чтобы ваш логические значения на самом деле хранятся в виде битов, а не слов.

Вы должны будете предоставить функции для getBool и setBool, используя операторы битовой маски для массива слов, и, опять же, производительность не будет cra sh -hot, но вы по крайней мере сможете тогда go до эквивалента:

' Using bits instead of words gives 16 times as much. '
Dim arr(8000, 8000, 8000) As Boolean

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

Надеюсь, я смог вам помочь.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...