VBA快速分配多对多编码

实例需求：第二个工作表中的城市编码表（下文中简称为编码表）如左图所示，其中城市数量不确定。第一个工作表中的待填写表格如中图所示，其中首列为非排序状态，并且填写编码时，不能改变首列的数据顺序。

编码填写要求：

• 根据地点从编码表中依次编号
• 如果城市名称在编码表中不存在，则第二列留空
• 如果编码表中对应城市的编码已经用完，则第二列留空
• 注意：编码表中B列编号并非规律顺序编号

实例代码如下。

Sub Demo()
    Dim objDic As Object, rngData As Range
    Dim i As Long, sKey, arrData
    Set objDic = CreateObject("scripting.dictionary")
    Set rngData = Sheets(2).Range("A1").CurrentRegion
    arrData = rngData.Value
    For i = LBound(arrData) + 1 To UBound(arrData)
        sKey = arrData(i, 1)
        If Not objDic.exists(sKey) Then
            Set objDic(sKey) = New Collection
        End If
        objDic(sKey).Add item:=arrData(i, 2), key:=CStr(objDic(sKey).Count + 1)
    Next i    
    Set rngData = Sheets(1).Range("A1").CurrentRegion
    arrData = rngData.Value
    For i = LBound(arrData) + 1 To UBound(arrData)
        sKey = arrData(i, 1)
        If objDic.exists(sKey) Then
            If objDic(sKey).Count>0 Then
                arrData(i, 2) = objDic(sKey)(1)
                objDic(sKey).Remove 1
            End If
        End If
    Next i
    rngData.Value = arrData
End Sub

【代码解析】
第4行代码创建字典对象。
第5行代码获取将第2工作表中的数据区域。
第6行代码将工作表中的数据加载到数组中。
第7~13行代码循环处理数据。
第8行代码读取第1列的单元格内。
第9行代码判断城市是否已经存在于字典对象中，如果不存在，第10行代码将为该键值创建Collection对象。
第12行代码将编码添加到Collection对象中。
第14~15行代码将第1个工作表中的数据表读取到数组中。
第18行代码判断城市是否已经存在于字典对象中。
如果存在，第19行代码判断该键值对应的Collection对象中是否存在item。
第20行代码将提取Collection对象中的第一个元素，作为该城市的编码。
第21行代码从Collection对象中删除第一个元素。
第25行代码将数据表写入到工作表。

经常有人问，VBA中字典对象和Collection对象都可以用于保存一组数据，应该如何选择呢？其实没有一定之规，二者主要区别在于Collection对象中没有Exists方法。还是要根据实际问题来决定使用哪种对象，例如对于本示例来说，使用了字典嵌套Collection对象的方式，如果使用字典嵌套字典的方式同样也可以实现。Collection对象无需使用CreatObject，所以只要能够使用Collection对象解决的，就不使用字典对象，当然这仅仅是笔者的个人编程习惯而已。