Question

我不知道还有什么地方可以转过来，我试着找到像我一样但没有运气的问题。我有一个原始的远程表，我想将信息复制到一个新的表，然后将复制的信息转换为ListObject表。我已经完成了99％，但后来我想将复制表的原始标题更改为我自己的标题（因为大多数原始标题都很长）。

我构建了一个循环来查看[#Headers]单元格，找到与某个原始值匹配的值，然后用我自己的值替换它。 E.g。

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多个实例执行此操作的代码块很麻烦，如果我收到的原始信息以某种方式更改了它的标头值，那么我必须再次搜索这段代码并进行更改。我希望有一种方法可以存储任何Sub可以引用的前后标题名称的2列表列表，如全局数组（全局数组除外）。我查看了课程，但是我还有一些问题需要全球化。

我正在考虑制作一个带有2个列表的隐藏工作表，但我真的希望没有必要，不要再需要更多的工作表了。有没有办法在Excel VBA中存储全局使用的列表？

Example image

解决方案：

使用@Mat's Mug建议，我将展示如何弄清楚我是如何添加词典的。

我创建了一个名为DHeader的公共变体，并创建了一个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

然后在我的行动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

现在我的价值观和行动被分成了我代码的不同部分。我想我必须添加一种方法来清除动作子中的字典，但它确实有用！

Answer 1

无论你做什么，你都需要在某处拥有mappping代码。

如果巨大的If-Then-Else块不是很吸引人，您可以考虑使用Dictionary库中的Scripting对象 - 使用“之前”列名作为您的字典键，以及“after”列名作为您的字典值，映射代码可能如下所示：

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

然后，当您迭代标题行中的单元格时，可以验证字典中是否存在名称/键，然后通过获取映射值继续重命名。只是不要假设字典中存在列名，或者最终运行“Key not exists”运行时错误。

Answer 2

字典的替代方法（尽管这可能是我首选的方法，我会在一个单独的过程中初始化它们）将是分割字符串：

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

您可以在模块级别对数组进行范围调整，以便它们可用于其他过程调用等。

Answer 3

为什么不使用简单的VBA Collection？无需额外引用，无需后期绑定，直接构建到VBA中。

注意：如果在地图中找不到该项，则不会替换原始的原始标题值，但只是跳过它。

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

VBA Excel - 在VBA中存储列表的方法？

3 个答案: