带有动态数组的 VBA 字典

Question

我正在尝试创建一个包含动态数组的动态字典。

电子表格中的示例行：

Facility Name|Contact Name|Contact Role

设施和联系人之间的关系是 M2M。我想重新创建一个如下所示的工作表：

Contact Name| Facility1 - role, Facility2 - role

我想做的是创建一个名称字典，其中唯一的名称用作键

New Dictionary  Names(name)

Names(name) 的值将是该名称出现的所有行号的数组。例如，假设“Joe Rose”出现在第 3、7 和 9 行：

names("Joe Rose") = [3,7,9]

我知道如何在 JS、Python、PHP 中做到这一点，但 VBA 让我发疯！

这是我目前得到的结果：

Dim names As Dictionary
Set names = New Dictionary

Dim name

For i=1 To WorkSheets("Sheet1").Rows.Count
  name = WorkSheets("Sheet1").Cells(i,2)
  If Not names(name) Then
    names(name) = i
  Else
    'help!
    'names(name)) push new i, maybe something with redim preserve?
  End If
Next i

即使只是将我指向一些我可以参考的文章也会很棒！来自 PHP 背景的 VBA 真是令人沮丧！

谢谢

Answer 1

这有点棘手，因为您必须将数组从字典中拉出来才能使用它，然后再放回去：

Sub Tester()

    Dim names As Dictionary
    Set names = New Dictionary

    Dim name, tmp, ub, i, k

    For i = 1 To Worksheets("Sheet1").UsedRange.Rows.Count

        name = Trim(Worksheets("Sheet1").Cells(i, 2).Value)

        If Len(name) > 0 Then
            If Not names.Exists(name) Then
                names(name) = Array(i)
            Else
                tmp = names(name)
                ub = UBound(tmp) + 1
                ReDim Preserve tmp(0 To ub)
                tmp(ub) = i
                names(name) = tmp
            End If
        End If
    Next i

    For Each k In names.Keys
        Debug.Print k, Join(names(k), ",")
    Next k


End Sub

Answer 2

让我们这样做。首先将字典的值构建为逗号分隔的字符串。然后，如果您需要/想要，您可以使用SPLIT 函数将其转换为数组。

Dim names As Dictionary
Set names = New Dictionary

Dim name

For i = 1 To WorkSheets("Sheet1").Rows.Count
  name = WorkSheets("Sheet1").Cells(i,2)

  If names.Exists(name) Then
      names(name) = names(name) & "," & i
  Else
      names(name) = i
  Next

Next i

For each name in names
    names(name) = Split(name, ",")
Next

Answer 3

循环时尽量避免使用[worksheet].rows.count，excel 2010的值超过100万。

Public Sub test()
    Dim names As Dictionary
    Dim name
    Dim cell As Object

    'finds last row in column 2
    lastRow = Worksheets("Sheet1").Cells(Rows.Count, 2).End(xlUp).Row
    Set names = New Dictionary

    For Row = 1 To lastRow
        Set cell = Worksheets("Sheet1").Cells(Row, 2)
        name = Split(cell.Text, "|")(0)

        If names.Exists(name) Then
            names(name) = names(name) & ", " & Row
        Else
            names.Add name, Row
        End If
    Next Row
End Sub