VBA字典定位

原始数据：

数据

结果：

结果

要求：在结果表中根据 Part Number（即原始数据中的Item）提取PONumber和REMAIN_QTY（水平按计数横放）

Sub Cat()
    Dim arr
    Set d = CreateObject("scripting.dictionary")
    arr = Sheet3.[a1].CurrentRegion'原始数据
    For i = 2 To UBound(arr)'遍历原始数据
        d(arr(i, 6)) = d(arr(i, 6)) + 1'对item计数
'item/1....item/2....item/3....构建字典的key，item用array函数处理成数组
        d(arr(i, 6) & "/" & d(arr(i, 6))) = Array(arr(i, 4), arr(i, 7))
    Next
    With Sheet2
        For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row'查询字典
            For j = 1 To d(.Cells(i, 1).Value)'Part Number(Item)的计数
'查询字典内容，输出到单元格
                .Cells(i, j * 2).Resize(1, 2) = d(.Cells(i, 1).Value & "/" & j)
            Next
        Next
    End With
End Sub

结果：

结果1

示例文件下载：
链接: http://pan.baidu.com/s/1pKXicYn 密码: 2wdv