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

该代码可以工作200,000次迭代（181x101x11 HxWxD）（ROW为Long，其他dims为Integer），但是我不确定它是否能在此范围之外工作。

因此，如果有600000多个步骤，是否有更好的方法呢？像是预先分配空间或使用等待等？

Answer 1

创建一个可以循环通过的数组，循环完成后，设置一个范围对象以匹配该数组的尺寸，然后继续将该数组写入工作表。

未经测试：

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

Answer 2

作为一种较快的替代方法，您可以使用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"

Excel VBA脚本/大列表创建中的溢出问题

2 个答案: