Question

我想用他们的模型创建一个汽车制造商列表。为此，我使用字典，其中键是make，而item是模型的集合。例如：字典中的关键是＆＃34; Volkswagen＆＃34;并且该集合包含polo，cc，passat等... 代码从工作表中读取项目。问题是我不确定集合是否加载了模型类型。此外，我检查了调试选项，如何从字典中写出集合元素，但我得到了空消息。如果有人可以帮我修复此代码，我会非常高兴。

Sub collectModels()

Dim imp_wb As Workbook, new_wb As Workbook
Dim ws_imp As Worksheet, ws_new As Worksheet, ws_stnd As Worksheet, ws_model_list As Worksheet
Dim lastRow As Long, lastCol As Long
Dim rng As Range
Dim validate As String, model_key As String, model_item As String
Dim modelCollection As Collection


Set imp_wb = ThisWorkbook
Set ws_model_list = imp_wb.Sheets("MODEL_LIST")

'Set new_wb = Workbooks.Add
'Set ws_new = new_wb.Worksheets(1)

Set rng = ws_stnd.Range("A2:A68")

'ws_imp.Activate
ws_model_list.Activate
lastRow = Last(1)
lastCol = Last(2)

Set dict_ModelMapping = CreateObject("scripting.dictionary")
Set modelCollection = New Collection


For i = 1 To lastCol

model_key = ws_model_list.Cells(1, i).Value

    For j = 2 To lastRow

        'add items to collection
        model_item = ws_model_list.Cells(j, i).Value


        If Not model_item = "" Then
            modelCollection.Add model_item
        Else
            'add collection to dictionary
            dict_ModelMapping.Add model_key, modelCollection
            Set modelCollection = New Collection
            GoTo nextColumn
        End If
    Next j

nextColumn:

'DEBUG CODE
    For Each v In dict_ModelMapping.Key("SUZUKI")
        Debug.Print v
    Next v
Next i


'--- CHECK COLLECTIONS---

Dim tmpCollection As Collection
Dim showItem As String

For Each Key In dict_ModelMapping.Keys

    MsgBox ("--------------" & Key & "---------------")


Next

End Sub

Answer 1

以下是一个最小的例子：

创建字典
使用String
迭代词典中的每一项
打印每个字典值集合中的项目

您可以调整示例代码以适合您的工作表：

Option Explicit

Sub TestDictionaryOfCollections()

    Dim dic As Object
    Dim coll As Collection
    Dim str As String
    Dim var1 As Variant, var2 As Variant

    ' instantiate the dictionary
    Set dic = CreateObject("Scripting.Dictionary")

    ' VW
    Set coll = New Collection
    coll.Add "Golf"
    coll.Add "Polo"
    coll.Add "Passat"
    coll.Add "Tiguan"
    dic.Add Item:=coll, Key:="VW"

    ' Ford
    Set coll = New Collection
    coll.Add "Fiesta"
    coll.Add "Falcon"
    coll.Add "Mondeo"
    coll.Add "Sierra"
    dic.Add Item:=coll, Key:="Ford"

    ' debug
    For Each var1 In dic.Keys
        For Each var2 In dic(var1)
            Debug.Print var2
        Next var2
    Next var1

End Sub

Answer 2

我已经纠正了一些事情，并对其他人采取自由来让你的代码工作。使用选项explicit指令是一个好主意，因为它有助于调试：

Option Explicit


Sub collectModels()

  Dim imp_wb As Workbook
  Dim ws_model_list As Worksheet
  Dim lastRow As Long, lastCol As Long

  Dim model_key As String, model_item As String
  Dim modelCollection As Collection

  Set imp_wb = ThisWorkbook
  Set ws_model_list = imp_wb.Sheets("MODEL_LIST")

  With ws_model_list
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column

    Dim dict_ModelMapping As Object
    Set dict_ModelMapping = CreateObject("scripting.dictionary")

    Dim i As Integer, j As Integer
    For i = 1 To lastCol
      model_key = .Cells(1, i).Value
      Set modelCollection = New Collection
      lastRow = .Cells(.Rows.Count, i).End(xlUp).Row
      For j = 2 To lastRow
        'add items to collection
        model_item = .Cells(j, i).Value
        If model_item <> "" Then
          modelCollection.Add model_item
        End If
      Next j
      'add collection to dictionary
      dict_ModelMapping.Add model_key, modelCollection
    Next i

  End With

  'DEBUG CODE
  Dim v As Variant
  Dim coll As Collection
  Set coll = dict_ModelMapping("SUZUKI")
  For Each v In coll
    Debug.Print v
  Next v

  '--- CHECK COLLECTIONS---
  Dim key As Variant
  For Each key In dict_ModelMapping.Keys
    MsgBox ("--------------" & key & "---------------")
  Next

End Sub

Answer 3

处理空单元格非常重要。一旦列表结束，代码就会将字典与集合一起保存。要引用字典中的集合，您必须在循环内创建一个循环。

ws_model_list.Activate
lastRow = Last(1)
lastCol = Last(2)

Set dict_ModelMapping = CreateObject("scripting.dictionary")

For i = 1 To lastCol

model_key = ws_model_list.Cells(1, i).Value
Set modelCollection = New Collection
    For j = 2 To lastRow

        'add items to collection
        model_item = ws_model_list.Cells(j, i).Value

        If model_item <> "" Then
            modelCollection.Add model_item
        Else
            'add collection to dictionary
            dict_ModelMapping.Add Key:=model_key, Item:=modelCollection
            GoTo nextColumn
        End If

    Next j

nextColumn:

Next i



Dim v1 As Variant, v2 As Variant
    For Each v1 In dict_ModelMapping.Keys
        For Each v2 In dict_ModelMapping(v1)
            MsgBox (v2)
        Next v2
   Next v1

字典中的集合

3 个答案: