Проблема переполнения в скрипте Excel VBA / создании большого списка

Question

Мне нужно написать список описаний новых номеров деталей для загрузки.Есть несколько списков, первый список ~ 600 000 номеров.Части в основном представляют собой блок с высотой, шириной и размерами глубины.

Учитывая, что в нем 3 измерения / вектора, я подумал, что не может быть легко отформатирован в один столбец с помощью VBA.,Может я ошибаюсь и есть более простой способ.

For DEPTH = MIN_D To MAX_D Step STEP_D
    For WIDTH = MIN_W To MAX_W Step STEP_W
        For HEIGHT = MIN_H To MAX_H Step STEP_H
            ROW = ROW + 1
            Cells(ROW, COLUMN).Value = BLOCK & "-" & HEIGHT & "-" & WIDTH & "-" & DEPTH
        Next HEIGHT
    Next WIDTH
Next DEPTH

Код работает (ROW - Long, другие dim - Integer) для 200 000 итераций (181x101x11 HxWxD), но я не уверен, что он работает за пределами этого.

Так что, если есть600000+ шагов, есть ли лучший способ сделать это?Например, можно заранее выделить место или использовать ожидание и т. Д.

Answer 1

В качестве более быстрой альтернативы вы можете использовать Power Query.

Добавьте ваши параметры в таблицу:

+-------+-------+--------+-------+-------+--------+-------+-------+--------+
| MIN_D | MAX_D | STEP_D | MIN_W | MAX_W | STEP_W | MIN_H | MAX_H | STEP_H |
+-------+-------+--------+-------+-------+--------+-------+-------+--------+
|     1 |    11 |      1 |     1 |   101 |      1 |     1 |   181 |      1 |
+-------+-------+--------+-------+-------+--------+-------+-------+--------+

Теперь добавьте запрос:

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Change Type Numbers" = Table.TransformColumnTypes(Source,List.Transform(Table.ColumnNames(Source), each {_, Int64.Type})),
    ListDepth = List.Numbers(#"Change Type Numbers"[MIN_D]{0},(#"Change Type Numbers"[MAX_D]{0}-#"Change Type Numbers"[MIN_D]{0})/#"Change Type Numbers"[STEP_D]{0}+1,#"Change Type Numbers"[STEP_D]{0}),
    ListWidth = List.Numbers(#"Change Type Numbers"[MIN_W]{0},(#"Change Type Numbers"[MAX_W]{0}-#"Change Type Numbers"[MIN_W]{0})/#"Change Type Numbers"[STEP_W]{0}+1,#"Change Type Numbers"[STEP_W]{0}),
    ListHeight = List.Numbers(#"Change Type Numbers"[MIN_H]{0},(#"Change Type Numbers"[MAX_H]{0}-#"Change Type Numbers"[MIN_H]{0})/#"Change Type Numbers"[STEP_H]{0}+1,#"Change Type Numbers"[STEP_H]{0}),
    #"Make Table" = Table.FromList(ListDepth,Splitter.SplitByNothing(),{"Depth"}),
    #"Add Width" = Table.AddColumn(#"Make Table", "Width", each ListWidth),
    #"Expand Width" = Table.ExpandListColumn(#"Add Width", "Width"),
    #"Add Height" = Table.AddColumn(#"Expand Width", "Height", each ListHeight),
    #"Expanded Height" = Table.ExpandListColumn(#"Add Height", "Height"),
    #"Change Type Text" = Table.TransformColumnTypes(#"Expanded Height",List.Transform(Table.ColumnNames(#"Expanded Height"), each {_, type text})),
    #"Added Output" = Table.AddColumn(#"Change Type Text", "Output", each Text.Combine({"BLOCK",[Height],[Width],[Depth]}," - "), type text),
    #"Removed Other Columns" = Table.SelectColumns(#"Added Output",{"Output"})
in
    #"Removed Other Columns"

Answer 2

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

Не проверено:

Dim DEPTH As Long, MIN_D As Long, MAX_D As Long, STEP_D As Long
Dim WIDTH As Long, MIN_W As Long, MAX_W As Long, STEP_W As Long
Dim HEIGHT As Long, MIN_H As Long, MAX_H As Long, STEP_H As Long
Dim COLUMN As Long

' . . .

Dim wsArr As Variant
ReDim wsArr(roundUp((MAX_D - MIN_D) / STEP_D) * roundUp((MAX_W - MIN_W) / STEP_W) * _
            roundUp((MAX_H - MIN_H) / STEP_H) + 3, 1)
For DEPTH = MIN_D To MAX_D Step STEP_D
    For WIDTH = MIN_W To MAX_W Step STEP_W
        For HEIGHT = MIN_H To MAX_H Step STEP_H
            wsArr(Row, 1) = BLOCK & "-" & HEIGHT & "-" & WIDTH & "-" & DEPTH
            Row = Row + 1
        Next HEIGHT
    Next WIDTH
Next DEPTH

Dim rng As Range
With ActiveSheet
    Set rng = .Range(.Cells(1, COLUMN), .Cells(UBound(wsArr) + 1, COLUMN))
End With

rng.Value = wsArr

Function roundUp(ByVal dVal As Double) As Long
    If Int(dVal) = dVal Then
        roundUp = dVal
    Else
        roundUp = Int(dVal) + 1
    End If
End Function