使用VBA中的缺省数组来填充Excel WBS和大纲

我有一个WBS （工作分解结构），有多行（组纲要的顶级），每个顶级行都是一个活动。 直接参与的活动是涉及的angular色。

根据顶层活动（例如“计划”）的值，根据其在另一个工作表（“默认值”选项卡）上的相关表格中的值，填充以下级别中的单元格。

目前，活动（对应于angular色）下的行正在进行丑陋的索引/匹配查找，乘以25个angular色，可能导致电子表格停顿。

我认为可以解决这个问题的方法是将angular色默认值表放到一个持久数组中，并在用户放入顶级活动时反复使用数组中的值。 我只是不知道如何使数组持久化（所以VBA不重新填充它永远不会改变一个单元格的用户）。 如果“angular色默认值”表中的值发生更改，我可以使用工作表OnChange来处理该值，所以这不是问题。

第3行“活动1”是“活动行”在组合大纲已折叠时的样子。

第4-9行是“活动行”的外观，展开了组大纲，显示了基本angular色。

对于每个angular色，这是另一个选项卡上的表格，用于查找WBS选项卡上相应的活动/angular色单元格中的值。

Answer 1

每当需要查找时，我都会使用Dictionary对象的支持者。 在我的解决scheme下面，我使用嵌套字典返回顶级和活动的组合。 （注意：尽量了解您的业务需求，但是我确信我没有认真考虑，我也假设了一些初级以上的VBA知识，如果您有问题，请提问我们会尽力帮助）。

首先，创build一个新的模块来容纳全球可用的Dictionary 。 这不能是一个Worksheet模块。 （在VBE中，转到插入 – >模块）。 在模块的顶部，在创build子例程之前，声明一个公共可用的Dictionary

 Public oDictWbs As Object 

我们只想要这个字典的一个实例，所以我喜欢使用一个Singleton模式，如果已经创build了这个模式就会返回一个Dictionary ，如果没有，就创build并返回一个新的。 （注意：我将例程返回到RefreshWBS以便它可以用来根据业务规则创build一个新的字典。例如，在默认工作表OnChange事件中，可以调用RefreshWBS [code重用总是很有趣]）。

 Private Function GetWBS() As Object If Not oDictWbs Is Nothing Then Set GetWBS = oDictWbs Exit Function End If Set GetWBS = RefreshWBS() End Function Private Function RefreshWBS() Dim sDefault As Worksheet Dim rTopLevels As Range Dim rActivities As Range Dim rIterator As Range Dim rInnerIter As Range Set oDictWbs = Nothing 'Both variables below establish the range that stores the fixed info (the default worksheet) 'Instead of hard coding in the range, create your own logic based on your needs and rules Set sDefault = Sheets("Default") Set rTopLevels = sDefault.Range("B1:C1") Set rActivities = sDefault.Range("A3:A4") Set oDictWbs = CreateObject("Scripting.Dictionary") For Each rIterator In rTopLevels If Not oDictWbs.exists(rIterator.Value) Then Set oDictWbs(rIterator.Value) = CreateObject("Scripting.Dictionary") End If For Each rInnerIter In rActivities If Not oDictWbs(rIterator.Value).exists(rInnerIter.Value) Then oDictWbs(rIterator.Value)(rInnerIter.Value) = sDefault.Cells(rInnerIter.Row, rIterator.Column) End If Next rInnerIter Next rIterator Set RefreshWBS = oDictWbs End Function 

最后，我们创build一个可以从Worksheet本身访问的函数，允许用户访问WBS Dictionary中的信息。 您可以在Excel单元格中input函数，如=GetWbsActivityTime(B1, A4)假定单元格B1包含顶级描述符，A4描述该活动。 只要该值在字典中，它就会返回与之相关的值。

 Function GetWbsActivityTime(sTopLevel As String, sActivity As String) As Variant Dim oDict As Object Set oDict = GetWBS() If Not oDict.exists(sTopLevel) Then GetWbsActivityTime = CVErr(xlErrRef) Exit Function End If If Not oDict(sTopLevel).exists(sActivity) Then GetWbsActivityTime = CVErr(xlErrRef) Exit Function End If GetWbsActivityTime = oDict(sTopLevel)(sActivity) End Function 

我知道吸收很多东西，所以请回顾一下，让我知道我可以帮助的任何问题或怪癖。 另外，如果我完全错过了练习的要点，让我知道，我会看看我们是否可以挽救部分解决scheme。