Excel递归过程来创建数组

Question

我有以下数据：

我的目标是这样做：

• 将创建一个填充材料的数组的递归子。
• 每次将材质设置为“精心制作”时，数组将在同一维度添加另一个子材质，并添加“.1”。示例：如果我们看一下弓，它是精心设计的，所以完成后数组看起来像这样：材质：数组（0,0,0）=木材，数量：数组（0,0,1）= 2，等级：数组（0,0,2）= 1。
• 但是，子级将成为：Material：array（0,1,0）= Branch，Quantity：array（0,1,1）= 2，Level：array（0,1,2）= 1.1 < / LI>
• 由于分支是精心设计的：材质：数组（0,2,0）=树，数量：数组（0,2,1）= 1，等级：数组（0,2,2）= 1.1.1。
• 然后：材料：数组（0,3,0）=叶子，数量：数组（0,3,1）= 9，等级：数组（0,3,2）= 1.2。
• 然后它将寻找下一个材料“绳子”并继续：材料：数组（1,0,0）=绳索，数量：数组（1,0,1）= 1，等级：数组（1， 0,2）= 1，材料：数组（1,1,0）= Web，数量：数组（1,1,1）= 10，等级：数组（1,1,2）= 2.1等等。 / LI>

我的主要问题是我对递归代码并不熟悉，而且我的逻辑似乎不对，所以我想我会寻求帮助，并在这里询问它是如何完成的。

到目前为止，这是我的代码，它部分有效：

Sub Look(ByRef arrayMaterials)

Dim item

    With ActiveSheet
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With

    With ActiveSheet
        lastColumn = .Cells(j + 2, .Columns.Count).End(xlToLeft).Column
    End With

For i = 0 To lastRow
    For y = 0 To lastColumn
        item = Cells(i + 2, 1).Value
        If Cells(i + 1, y + 1).Value = item And Cells(i + 1, y + 1).Value <> "Item" Then
            arrayMaterials = ReDimPreserve(arrayMaterials, i, i, y)
            arrayMaterials(i - 1, i - 1, y - 2) = Cells(i + 1, y + 1).Value
            arrayMaterials(i - 1, i - 1, y - 1) = Cells(i + 1, y + 2).Value
            level = level & CInt(Right(Cells(1, y + 3), 2))
            arrayMaterials(i - 1, i - 1, y) = level
            level = CInt(Right(Cells(1, y + 3), 2))
                If Cells(i + 1, y + 1).Value <> "Resource" Then
                    level = level & "."
                    Look (arrayMaterials)
                End If
        End If
    Next
Next

Look (arrayMaterials)

End Sub

被叫：

Sub CallLook()
    Dim arrayMaterials(1, 1, 1)
    Look (arrayMaterials)
End Sub

另外（为了摆脱最后一个维度的保留限制）：

Public Function ReDimPreserve(aArrayToPreserve, nNewFirstUBound, nNewSecondUBound, nNewLastUBound)
    ReDimPreserve = False
    'check if its in array first
    If IsArray(aArrayToPreserve) Then
        'create new array
        ReDim aPreservedArray(nNewFirstUBound, nNewSecondUBound, nNewLastUBound)
        'get old lBound/uBound
        nOldFirstUBound = UBound(aArrayToPreserve, 1)
        nOldSecondUBound = UBound(aArrayToPreserve, 2)
        nOldLastUBound = UBound(aArrayToPreserve, 3)
        'loop through first
        For nFirst = LBound(aArrayToPreserve, 1) To nNewFirstUBound
            For nSecond = LBound(aArrayToPreserve, 2) To nNewSecondUBound
                For nLast = LBound(aArrayToPreserve, 3) To nNewLastUBound
                    'if its in range, then append to new array the same way
                    If nOldFirstUBound >= nFirst And nOldSecondUBound >= nSecond And nOldLastUBound >= nLast Then
                        aPreservedArray(nFirst, nSecond, nLast) = aArrayToPreserve(nFirst, nSecond, nLast)
                    End If
                Next
            Next
        Next
        'return the array redimmed
        If IsArray(aPreservedArray) Then ReDimPreserve = aPreservedArray
    End If
End Function

变量“level”是全局声明的。

你可以帮我解决一下这段代码没用吗？

我想我可能有一些索引（i和y）错了。我也不熟悉编码。

感谢所有帮助。

编辑：根据评论中的要求，这里是arry和Excel的输出：

阵列：

(0,0,0) = Wood, 2, 1
(0,1,0) = Branch, 2, 1.1
(0,1,1) = Tree, 1, 1.1.1
(0,2,0) = Leaf, 9, 1.2
(1,0,0) = Rope, 1, 2
(1,1,0) = Web, 10, 2.1
(1,1,1) = Spider, 5, 2.1.1
(2,0,0) = Crystal, 3, 3
(3,0,0) = Shard, 8, 4
(4,0,0) = Plumes, 1, 5
(4,1,0) = Bird, 1, 5.1

Excel（每个条目都是一行，项目和数量在同一列上，由于限制，我无法添加列）：

Bow (is already on the other sheet, no need to add it, "-" are indents)
-Wood - 2
--Branch - 4 (2 Wood, so 4 Branches)
---Tree - 4
--Leaf - 18
-Rope - 1
--Web - 10
---Spider - 50
-Crystal - 3
-Shard - 8
-Plumes - 1
--Birds - 1

我希望它能让你更好地了解我的需求。

编辑：2015-07-13 - 根据Tony Dallimore的建议添加新代码：

请注意，这不是成品，我仍然需要传递我想要材料的项目并对输出进行编码，我想确保在进一步说明之前我会理解所有内容。

在我的数据表中，我得到了一个调用sFilltypes的按钮。

Public Type tComponent   RowMaterial As Long   Quantity As Long End Type

Public Type tMaterial   Name As String   Crafted As Boolean   Used As Boolean   Component() As tComponent End Type

Sub sFillTypes()

Dim count
Dim Materials() As tMaterial

With ActiveSheet
    lastRow = .Cells(.Rows.count, "A").End(xlUp).Row
End With

ReDim Materials(1 To lastRow - 1)

For i = 2 To lastRow
    count = 0
    With ActiveSheet
        lastColumn = .Cells(i, .Columns.count).End(xlToLeft).Column
            For k = 1 To lastColumn
            If Left(Cells(1, k), 8) = "Material" And Cells(1, k).Value <> "" Then
                count = count + 1
            End If
        Next
    End With
    ReDim Materials(i - 1).Component(1 To 1)
    If UBound(Materials(i - 1).Component, 1) <= count Then
        ReDim Materials(i - 1).Component(1 To count)
    Else
        Erase Materials(i - 1).Component
    End If
    Materials(i - 1).Name = Cells(i, 1).Value
        If Cells(i, 2).Value = "Crafted" Then
            Materials(i - 1).Crafted = "True"
        Else
            Materials(i - 1).Crafted = "False"
        End If
    For y = 1 To lastColumn + 1
        If InStr(Cells(1, y).Value, "Material") Then
            For Z = 1 To lastRow
                If Cells(i, y).Value = Cells(Z, 1).Value Then
                    Materials(i - 1).Component(Right(Cells(1, y), 2)).RowMaterial = Z
                    Materials(i - 1).Component(Right(Cells(1, y), 2)).Quantity = Cells(i, y + 1)
                End If
            Next
        End If
    Next
Next

End Sub

Answer 1

弓（已在另一张纸上，......

我怀疑这是一个好主意。

根据您的演示数据，“bow”是唯一不属于其他内容的材料。你的真实数据会是这样吗？您如何知道数组中哪些元素与工作表中的哪一行相关？

也许更重要的是，下一步处理所需的数据分布在两个来源上。您可能正在节省空间（数组会稍微小一些），但这会使您的代码更复杂，更慢。我记得当空间紧张时（我是程序员的第一台商用计算机，操作系统和16位用户的内存介于45到1000Kb之间）我们会接受更高的复杂性和更慢的运行时间作为适合我们程序的必要价格进入可用的内存。你不必做出牺牲。一个简单的程序编写起来更快，更易于维护，更可靠，所以从简单开始。

†我不是在开玩笑;我的确意味着最大内存是1Mb。

我的理解是您希望将工作表中的数据传输到内存中，以便更方便地进行处理。我发现很难看出你的数组如何方便任何事情。创建它所需的处理也很复杂。你花了多长时间写ReDimPreserve？

请考虑以下替代结构。

  |   1   |     2  | 3| 4| 5| 6| 7| 8| 9|10|11|12|
--|-------|--------|--|--|--|--|--|--|--|--|--|--|
 1|Bow    |Crafted | 2| 2| 3| 1| 5| 3|10| 8| 6| 1|
 2|Wood   |Crafted | 4| 2|12| 9|
 3|Rope   |Crafted | 8|10|
 4|Branch |Crafted |13| 1|
 5|Crystal|Resource|
 6|Plumes |Crafted | 7| 1|
 7|Bird   |Resource|
 8|Web    |Crafted |11| 5|
 9|String |Resource|
10|Shard  |Resource|
11|Spider |Resource|
12|Leaf   |Resource|
13|Tree   |Resource|

这称为参差不齐的数组，因为每行的长度不同。这在逻辑上与工作表相同。第1,2,4,6,8,10和12列中的值保持不变。第3栏，第5栏，第7栏，第9栏和第11栏中的单词已被行号替换。例如：“Wood”已替换为“2”，“Rope”已替换为“3”，其中“2”和“3”是包含Wood和Rope详细信息的行。 （我手工制作了这张桌子，但我相信即使有错误你也可以看到这个想法。

我希望你能看到从Bow到它的每个组件（Wood，Rope，Crystal，Shard和Plumes），从Wood到它的组件（Branch和Leaf），并不困难。我也希望你能看到将工作表转换为这个数组不会有什么大问题。

在此阶段不要担心如何创建一个参差不齐的数组而不是方形数组或多维数据集数组。在这个阶段，我想让你考虑数据结构。获得正确的数据结构，程序结构将很容易。由于数据结构错误，程序将难以编码。

上述结构很简单但不能自我记录。第7列是材料还是数量？对于这个问题，结构自我记录可能并不重要，但对于更复杂的问题，它可能会很重要。

Long，String，Double和Boolean是编程语言附带的内在数据类型。这些内在数据类型通常是足够的，但有时它们不是。我所知道的所有通用语言都有一些从这些简单数据类型构建更复杂数据类型的方法。大多数语言将这些复杂的数据类型称为“结构”，但VBA将其称为“用户类型”。考虑：

Type tComponent
  RowMaterial As Long
  Quantity As Long
End Type

Type tMaterial
  Name As String
  Crafted As Boolean
  Component() As tComponent
End Type

语句Type xxx到End Type定义用户类型。我似乎总是希望对类型和变量使用相同的名称。我的惯例之一是为类型名称设置一个前导“t”。

我首先定义精制材料的一个组件。组件对应于列（3,4），（5,6）等。然后我定义了一个具有名称的材料，一个用于记录精心设计或资源的布尔值以及一组组件。如果资料是资源，则Crafted将为False，并且不会使用Component。如果制作了素材，则Crafted将为True，Component将ReDimed为Type，并存储值。

考虑Type tMaterial与工作表行的关系。第1列包含名称，第2列包含“Crafted”或“Resource”。我已经用布尔变量替换了第2列，但这只是对相同信息进行编码的另一种方式。 Sub ShowConcept() Dim Materials() As tMaterial ReDim Materials(1 To 13) Materials(1).Name = "Bow" Materials(1).Crafted = True ReDim Materials(1).Components(1 To 5) Materials(1).Components(1).RowMaterial = 2 Materials(1).Components(1).Quantity = 2 Materials(1).Components(2).RowMaterial = 3 Materials(1).Components(2).Quantity = 1 Materials(1).Components(3).RowMaterial = 5 Materials(1).Components(3).Quantity = 3 ' : : : Materials(2).Name = "Wood" Materials(2).Crafted = True ReDim Materials(2).Components(1 To 2) Materials(2).Components(1).RowMaterial = 4 Materials(2).Components(1).Quantity = 2 Materials(2).Components(2).RowMaterial = 12 Materials(2).Components(2).Quantity = 8 ' : : : End Sub tComponent，其中包含标识组件和数量的行号，与列对（3,4），（5,6）等匹配。最大的区别是tMaterial是自我记录的。如果你在六个月或十二个月内回到这些宏，这两种方法中哪一种更容易理解？我相信方法2会更容易。如果要维护宏或任何其他程序以满足不断变化的要求，那么维护程序员的生活变得非常重要;毕竟，你可能是那个维护程序员。

以下代码显示了如何使用这些用户类型：

Type

上面的两个数据结构在逻辑上是相同的;他们只展示了两种达到同样效果的方法。虽然感觉不错，但我还没有对数据结构进行过心理测试。下一步是“使用”这种结构。可能有必要修改甚至放弃我的第一次针对您的问题的适当数据结构的尝试，但我希望不会。

您需要三个宏。您需要一个宏来从原始工作表创建数组，另一个宏从数组创建新工作表。使用演示数据时，只有一种材料不是另一种材料的组成部分。您可以创建一个宏来输出数组的第1行的组件（工作表的第2行）。但是你的真实数据可能有几个这样的“未使用”的材料，我想，你希望它们都能输出到新的工作表中。您需要一个控制宏来调用创建数组的宏，然后为每个未使用的材料调用输出宏。

宏如何识别未使用的材料？使用工作表和当前数组，不会立即明白哪些材料未使用。例如，第9行描述的材料是否使用过？我需要查看所有其他行。只有当没有其他行使用第9行的材料时才会使用它。我需要Type tMaterial Name As String Crafted As Boolean Used As Boolean Component() As tComponent End Type tMaterial的新属性：

Used

对于每种材料，Used的初始值为False。在构建阵列时，通过将Variant设置为True来记录对材料的任何使用。

现在设计我们的主要两个宏。

阵列创建宏的第一步是将工作表导入Variant。第一个数据行是2.您可以将最后使用的行标识为14.第一列是1.您可以将最后使用的列标识为12.单个语句将此范围加载到 | 1 | 2 | 3 | 4| 5 | 6| 7 | 8| 9 |10| 11 |12|13| --|-------|--------|------|--|----|--|-------|--|-----|--|------|--|--| 1|Bow |Crafted |Wood | 2|Rope| 1|Crystal| 3|Shard| 8|Plumes| 1| | 2|Wood |Crafted |Branch| 2|Leaf| 9| | | | | | | | 3|Rope |Crafted |Web |10| | | | | | | | | | 4|Branch |Crafted |Tree | 1| | | | | | | | | | 5|Crystal|Resource| | | | | | | | | | | | 6|Plumes |Crafted |Bird | 1| | | | | | | | | | 7|Bird |Resource| | | | | | | | | | | | 8|Web |Crafted |Spider| 5| | | | | | | | | | 9|String |Resource| | | | | | | | | | | | 10|Shard |Resource| | | | | | | | | | | | 11|Spider |Resource| | | | | | | | | | | | 12|Leaf |Resource| | | | | | | | | | | | 13|Tree |Resource| | | | | | | | | | | | ，这将创建一个阵列。我将导入一个额外的空白列给出：

  |   1   |     2  |   3  | 4| 5  | 6| 7     | 8|  9  |10|  11  |12|13| 
--|-------|--------|------|--|----|--|-------|--|-----|--|------|--|--|
 1|Bow    |Crafted |     2| 2|Rope| 1|Crystal| 3|Shard| 8|Plumes| 1|  |
 2|Wood   |Crafted |Branch| 2|Leaf| 9|       |  |     |  |      |  |U |
 3|Rope   |Crafted |Web   |10|    |  |       |  |     |  |      |  |  |

我现在需要沿着每一行查看第3,5,7,9和11列。任何材料名称都必须替换为相关的行号。由于这是一个变量数组，我可以用数值替换字符串值。

例如，在元素R1C3中，我找到“Wood”。我需要向下看第1列中的“Wood”，我在第2行找到它。我将R1C3设置为2，将R2C13设置为“U”以表示使用了木材：

  |   1   |     2  |   3  | 4| 5  | 6| 7     | 8|  9  |10|  11  |12|13| 
--|-------|--------|------|--|----|--|-------|--|-----|--|------|--|--|
 1|Bow    |Crafted |     2| 2|   3| 1|Crystal| 3|Shard| 8|Plumes| 1|  |
 2|Wood   |Crafted |Branch| 2|Leaf| 9|       |  |     |  |      |  |U |
 3|Rope   |Crafted |Web   |10|    |  |       |  |     |  |      |  |U |

我重复R1C5，在那里找到“Rope”。我向下看第1列的“绳索”，我在第3行找到它。我将R1C5设置为3，将R3C13设置为“U”，给出：

Type

要将原始工作表转换为此答案顶部的表单（第13列除外），我需要：

• 每行（1到13）的外部循环。
• 每个列3,5等的内部循环，包含材料名称。
• 内部循环搜索行的材质名称。

我不需要递归来创建这个结构。我可以在这个表单上使用修改过的数组，但我相信如果将数据移动到Bow - 1 tMaterial数组，它将使新工作表创建宏更容易理解。

据我了解，您要输出值的特定工作表的特定列。此工作表的名称，列字母/数字和第一行编号可以硬编码到宏中，定义为常量或是宏的参数。我将忽略工作表和列，但会使行号成为宏的参数。

对于您可能想要的宏的第一行：

Bow - 1
>Wood – 2
>Rope – 1
»Crystal – 3
»Shard – 8
>Plumes – 1

我首先看到你的问题意味着你希望这一行被压制，但我不确定这是否是正确的解释。不管;我将解释如何抑制此行或使其与其他行稍后不同。

在第一行下，您需要列出Bow组件的行：

Bow - 1
>Wood – 2
>>Branch – 4
>>Leaf – 18
>Rope – 1
>Crystal – 3
>Shard – 8
>Plumes – 1

我使用“＆gt;”来表示缩进，因为我假设名称后面的连字符是真正的连字符。 1,2,1,3,8和1是数量。

在Wood的行下，您需要列出其组件的行，但您希望数量乘以2，Woods的数量：

OutMatRow

Branch和Leaf是资源，没有组件，但如果它们有组件，你会希望Wood下的那些组件列出。

这绝对是递归将是最简单技术的要求。

递归例程（我们称之为Materials）将需要许多参数：

• RowMaterial：第一个宏创建的数组。
• Materials：RowOutput中当前材料的行。
• Quantity：输出列中的行。
• NumIndents：当前材料的数量。
• Materials：当前材料的缩进次数。

我说“参数”但OutMatRow可能是全局变量，因为RowOutput不会更改此数组。 RowMaterial也可以是全局变量，因为每次输出行时都会更新源变量。 Quantity，NumIndents和OutMatRow必须是参数，因为每个调用都需要自己的参数值。

控制程序将为每个未使用的材料调用Call OutMatRow(Materials, 2, X, 1, 0) 。使用您的演示数据时，唯一未使用的材料是Bow，因此呼叫将是：

OutMatRow

其中X代表第一个输出行的编号。

NumIndents中的代码很少。

• 必须输出材料的行。 Materials(RowMaterial).Name，Quantity和NumIndents = 0为此行提供值。如果需要，您可以在RowOutput时使用不同的格式或抑制输出。
• Call OutMatRow(Materials, _ Materials(RowMaterial).Component(N).RowMaterial, _ RowOutput, _ Quantity * _ Materials(RowMaterial).Component(N).Quantity, _ NumIndents + 1) 必须为下一个输出行做好准备。

• 对于精制材料的每个组件，例程将自行调用：

  OutMatRow

如果您不熟悉递归例程，则理解OutMatRow调用的顺序有点困难：

• 控制宏为Bow调用OutMatRow。
• OutMatRow输出Bow的行，并将自己称为Bow的第一个组件Wood。
• OutMatRow输出Wood的行，并为Wood的第一个组件（即Branch）调用自己。
• OutMatRow输出Branch的行。 Branch没有组件，因此例程返回其调用者。
• OutMatRow称自己为Wood的第二个组件，即Leaf。
• OutMatRow输出Leaf的行。 Leaf没有组件，所以例程返回给它的调用者。
• Wood没有其他组件，因此例程返回其调用者。
• {{1}}称自己为Bow的第二个组成部分，即Rope。
• 等等。

这很难让你头脑发热。尝试我给出的解释。如果你还在努力回来问题，我会尝试不同的解释。

Answer 2

每个答案限制为30,000个字符，我必须接近。将第一个答案与答案的后续答案分开也是有价值的。

您的日常生活中存在一些需要纠正的问题。我已经做了一点OTT并且因为良好的练习而做出了改变。我还添加了一个例程，显示材料作为检查它是否正确。研究我的代码，并尝试确定为什么我做了我所做的更改。如有必要，请回答问题。

Option Explicit

Public Type tComponent
  RowMaterial As Long
  Quantity As Long
End Type

Public Type tMaterial
  Name As String
  Crafted As Boolean
  Used As Boolean
  Component() As tComponent
End Type
Sub sFillTypes()

  ' Constants have two major benefits:
  '  * Instead of literals your code contains meaningful names making your
  '    code easier to read.
  '  * If the value changes, one amendment here fixes the code. For example,
  '    suppose a new column is added on the left. Looking through the code
  '    deciding which 2s, 3s and 4s are to be changed to 3s, 4s and 5s is
  '    nightmare.
  ' Variable names should be meaningful.  Reading code full of Ks, Xs and Ys
  ' is difficult because the reader has to remember what they are. My system
  ' is to use a sequence of words or abbreviations. The first word says what
  ' I am using the variable for: Col=column number, Row=row number, etc.
  ' Each additional word reduces the scope until I have a unique name. I do
  ' not know the name of your worksheet so I have used Sht as the second word
  ' of variables that relate to the worksheet. Crnt (=current), First and Last
  ' are common words in my names. I can look at routines I wrote 10 years ago
  ' and immediately know what all the variables are which is a real help when
  ' trying to update them.  If you do not like my system, develop your own.

  Const ColShtItem As Long = 1
  Const ColShtType As Long = 2
  Const ColShtMatFirst As Long = 3
  Const RowShtDataFirst As Long = 2

  Dim ColShtCrnt As Long
  Dim ColShtLast As Long
  Dim ColShtMatLast As Long
  Dim ColShtUsed As Long
  Dim Found As Boolean
  Dim InxComp As Long
  Dim Materials() As tMaterial
  Dim RowShtCrnt As Long
  Dim RowShtItem As Long
  Dim RowShtLast As Long
  Dim ValuesSht As Variant

  With ActiveSheet

    ' Cell.End is a convenient way of finding the last used cell in a row or column.
    ' It is probably a reliable way of finding the last row of your worksheet but you
    ' are relying on row 1 having a complete set of headers to determine the last column
    ' which makes me uncomfortable.
    RowShtLast = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByRows, xlPrevious).Row
    ColShtLast = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByColumns, xlPrevious).Column

    ' I do not know what you are doing with Count but this code cannot be at the top.  Each
    ' row will have its own number of materials

    ' * This statements loads the values of the range to ValuesSht as an array.
    ' * I have loaded the first data row to the last row because I do not want the
    '   header row. I have loaded column 1 to last column plus 1 because I want an extra,
    '   blank column on the left.
    ' * ValuesSht will become a 2D array with the first dimension being for rows and the
    '   second for columns.
    ' * The top left cell of ValuesSht will always be (1,1) even if the range does not
    '   start in cell (1,1).

    ValuesSht = .Range(Cells(RowShtDataFirst, 1), .Cells(RowShtLast, ColShtLast + 1))

  End With

  ReDim Materials(1 To UBound(ValuesSht, 1))

  ' I will use the RowSht variables for ValuesSht even though the worksheet and array
  ' rows do not match because I have finished with the worksheet.  The worksheet and
  ' array columns match so I will use the ColSht variables for both.
  ' I will also use the RowSht variables for Materials since the rows match.

  ColShtUsed = ColShtLast + 1      ' I load an extra column to hold used values

  For RowShtCrnt = 1 To UBound(ValuesSht, 1)

    ' Copy across the non-repeating values
    Materials(RowShtCrnt).Name = Trim(ValuesSht(RowShtCrnt, ColShtItem))
    Select Case LCase(Trim(ValuesSht(RowShtCrnt, ColShtType)))
      Case "crafted"
        Materials(RowShtCrnt).Crafted = True
      Case "resource"
        Materials(RowShtCrnt).Crafted = False
      Case Else
        ' Do not assume the worksheet is perfect.
        Call MsgBox("Cell B" & RowShtCrnt + RowShtDataFirst - 1 & _
                    " does nor contain ""Crafted"" or ""Resource""", vbOKOnly)
        Exit Sub
    End Select
    ' If materials are not always below the item that uses them, this block
    ' will have to be in its own loop after the rest of Materials has been created
    If ValuesSht(RowShtCrnt, ColShtUsed) = "U" Then
      Materials(RowShtCrnt).Used = True
    Else
      Materials(RowShtCrnt).Used = False
    End If

    If Materials(RowShtCrnt).Crafted Then

      ' Replace material names in columns ColShtMatFirst, ColShtMatFirst+2 and so on
      ' with the number of the row for the material.

      ' Loop over all possible material columns
      For ColShtCrnt = ColShtMatFirst To ColShtLast - 1 Step 2
        If Trim(ValuesSht(RowShtCrnt, ColShtCrnt)) = "" Then
          ColShtMatLast = ColShtCrnt - 2
          Exit For
        End If

        ' Look down the remainder of ValuesSht for this material.
        ' This relies on used materials always being below the material they are
        ' used to make.  This is a easy way of (1) preventing loops and (2) ensuring
        ' the used column is ready when required.  If materials are not in this
        ' sequence, you will need a more sophisticated method of detecting loops such
        ' as: Material1 used to make Material2, Material2 used to make Material3 and
        ' Material3 used to make Material1.
        Found = False
        For RowShtItem = RowShtCrnt + 1 To UBound(ValuesSht, 1)
          If Trim(ValuesSht(RowShtItem, ColShtItem)) = _
             Trim(ValuesSht(RowShtCrnt, ColShtCrnt)) Then
            ValuesSht(RowShtCrnt, ColShtCrnt) = RowShtItem
            Found = True
            Exit For
          End If
        Next RowShtItem
        If Not Found Then
          Call MsgBox("I cannot find the material in cell " & _
                      ColNumToCode(ColShtCrnt) & RowShtCrnt + RowShtDataFirst - 1 & _
                      " (" & ValuesSht(RowShtCrnt, ColShtCrnt) & ") defined on rows " & _
                      RowShtCrnt + 2 & " to " & UBound(ValuesSht, 1) + 1, vbOKOnly)
          Exit Sub
        End If
        ValuesSht(RowShtItem, ColShtUsed) = "U"  ' Record this item used
      Next ColShtCrnt

      ' For the current row, the material names in columns ColShtMatFirst, ColShtMatFirst+2
      ' and so on have been replaced by row numbers.  ColShtMatLast has been set as
      ' appropriate for this row.

      ' Size Components as required for this material and move component detals for ValuesSht
      ReDim Materials(RowShtCrnt).Component(1 To (ColShtMatLast - ColShtMatFirst) / 2 + 1)
      InxComp = 1
      For ColShtCrnt = ColShtMatFirst To ColShtMatLast Step 2
        Materials(RowShtCrnt).Component(InxComp).RowMaterial = ValuesSht(RowShtCrnt, ColShtCrnt)
        Materials(RowShtCrnt).Component(InxComp).Quantity = ValuesSht(RowShtCrnt, ColShtCrnt + 1)
        InxComp = InxComp + 1
      Next

    End If ' Materials(RowShtCrnt).Crafted

  Next RowShtCrnt

  ' Delete or comment out this line when you are satified the above code is correct.
  Call ListMaterials(Materials)



End Sub
Sub ListMaterials(ByRef Materials() As tMaterial)

  ' Debug.Print is very useful when debugging code.  The only downside is that the
  ' Immediate Window will only hold 200 or so lines.  After that, line at the top
  ' get lost.  If I have or expect too many lines for the Immediate Window, I use
  ' a text file.

  Dim InxComp As Long
  Dim InxMat As Long
  Dim InxMatUsed As Long
  Dim LenMatNameMax As Long
  Dim Name As String
  Dim NumCompMax As Long

  ' Determine maximum length of a material name and the maximum number of
  ' components so the output can be formatted nicely.
  LenMatNameMax = 0
  NumCompMax = 0

  For InxMat = LBound(Materials) To UBound(Materials)
    If LenMatNameMax < Len(Materials(InxMat).Name) Then
      LenMatNameMax = Len(Materials(InxMat).Name)
    End If
    If Materials(InxMat).Crafted Then
      If NumCompMax < UBound(Materials(InxMat).Component) Then
        NumCompMax = UBound(Materials(InxMat).Component)
      End If
    End If
  Next InxMat

  ' List Materials and their components

  ' Output header line
  Debug.Print Left("Name" & Space(LenMatNameMax), LenMatNameMax) & " T U |";
  For InxComp = 1 To NumCompMax
    Debug.Print Left("Material" & Space(LenMatNameMax), LenMatNameMax) & " Qty|";
  Next
  Debug.Print

  ' Output materials
  For InxMat = LBound(Materials) To UBound(Materials)
    Debug.Print Left(Materials(InxMat).Name & Space(LenMatNameMax), LenMatNameMax + 1) & _
                IIf(Materials(InxMat).Crafted, "C ", "R ") & _
                IIf(Materials(InxMat).Used, "Y ", "  ") & "|";
    If Materials(InxMat).Crafted Then
      For InxComp = 1 To UBound(Materials(InxMat).Component)
        Name = Materials(Materials(InxMat).Component(InxComp).RowMaterial).Name
        Debug.Print Left(Name & Space(LenMatNameMax), LenMatNameMax + 1) & _
                    Right("   " & Materials(InxMat).Component(InxComp).Quantity, 3) & "|";
      Next
    End If
    Debug.Print
  Next InxMat

End Sub
Function ColNumToCode(ByVal ColNum As Long) As String

  ' Last updated 3 Feb 12.  Adapted to handle three character codes.

  Dim ColCode As String
  Dim PartNum As Long

  If ColNum = 0 Then
    ColNumToCode = "0"
  Else
    ColCode = ""
    Do While ColNum > 0
      PartNum = (ColNum - 1) Mod 26
      ColCode = Chr(65 + PartNum) & ColCode
      ColNum = (ColNum - PartNum - 1) \ 26
    Loop
  End If

  ColNumToCode = ColCode

End Function