VBA Excel – 在VBA中存储列表的方法?

我不知道还有什么地方可以转,我试着find像我这样的问题,但没有运气。 我有一个原始的远程表,我想将信息复制到一个新的工作表,然后将复制的信息转换成一个ListObject表。 我已经完成了99%的工作,但是之后我想将复制的表格的原始标题更改为我自己的标题(因为大多数原始标题非常冗长)。

我构build了一个循环来查看[#Headers]单元格,find匹配某个原始值的值,然后用我自己的值replace它。 例如

For Each cl In Range("Table1[#Headers]") If cl.Value = "Employee" Then cl.Value = "Name" ElseIf cl = "Employer Name" Then cl.Value = "Company" '... End If Next cl 

有一个代码块为30多个实例执行此操作非常麻烦,而且如果我收到的原始信息改变了它的标题值,那么我必须再次search这些代码并进行更改。 我希望有一种方法可以存储任何Sub可以引用的前后标题名称的2列列表,就像全局数组(除了全局数组是不可能的)。 我看了一下课程,但是再次出现了全球化信息方面的问题。

我正在考虑制作一个隐藏的工作表,但是我真的希望这不是必要的,不需要更多的工作表。 有没有办法在Excel VBA中存储全局使用的列表?

示例图像

解:

使用@Mat's Mugbuild议,我会告诉我如何加我的字典。

我做了一个名为DHeader的公共变体,并创build了一个Sub to Call:

 Public DHeader As Dictionary Sub Load_Headers() If Not DHeader Is Nothing Then Exit Sub Set DHeader = New Dictionary With DHeader .add "Employee", "Name" .add "Employer Name", "Company" '... End With End Sub 

然后在我的行动中我加了这个:

 Call Load_Headers For Each i_1 In Range("Table1[#Headers]") If DHeader.Exists(CStr(i_1.Value)) = True Then i_1.Value = DHeader.Item(CStr(i_1.Value)) End If Next i_1 

现在我的价值和行动被分成我的代码的不同部分。 我想我必须添加一个方法来清除我的行动中的字典仍然,但它的作品!

不pipe你做什么,你都需要在某处放置代码。

如果一个巨大的If-Then-Else块不太吸引人,可以考虑使用Scripting库中的Dictionary对象 – 使用“before”列名作为字典键,并使用“after”列作为字典值,映射代码可能看起来像这样:

 Dim ColumnMap As New Scripting.Dictionary With ColumnMap .Add "Employee", "Name" .Add "Employer Name", "Company" '... End With 

然后,在迭代标题行中的单元格时,可以validation名称/关键字是否存在于字典中,然后通过获取映射的值继续进行重命名。 只是不要假定字典中存在列名,否则最终会遇到“密钥不存在”运行时错误。

字典的替代(尽pipe这可能是我的首选方法,我会在一个单独的过程中初始化它们)将是拆分string:

 Sub DoStuff() Const RawList As String = "Employee,Employer Name" Const UpdateList as String = "Name,Employer" Dim rawHeaders as Variant Dim headers as Variant rawHeaders = Split(RawList, ",") headers = Split(UpdateList, ",") For Each cl In Range("Table1[#Headers]") If Not IsError(Application.Match(cl.Value, rawHeaders, False)) Then cl.Value = headers(Application.Match(cl.Value, rawHeaders, False)) End If Next End Sub 

您可以在模块级别范围内的数组范围,所以他们将可用于其他过程调用等

为什么不使用简单的VBA集合? 不需要额外的参考,不需要延迟绑定,直接构build到VBA中。

注意:如果在地图中没有find该项目,那么原始的原始标题值不会被replace,而是简单地被跳过。

 Option Explicit Public Sub Main() Dim header As Range Set header = Worksheets("RawData").ListObjects("Table1").HeaderRowRange ReplaceInheaderRow headerRow:=header ' header contains transformed values now End Sub Private Function ReplaceInheaderRow(ByVal headerRow As Range) As Range Dim map As Collection Set map = New Collection map.Add "Name", "Employee" map.Add "Company", "Employer Name" map.Add "ID", "ID Numbers" map.Add "Income", "Wages" map.Add "etc.", "Some next column name" On Error Resume Next Dim rowHeaderCell As Range For Each rowHeaderCell In headerRow rowHeaderCell.Value = map(rowHeaderCell.Value) Next rowHeaderCell On Error GoTo 0 End Function