excel出入库汇总，用字典方法实现。

1007467564

1、工作簿中前面三个表都存在另两个表没有的货品；如“入库数据”表dd，其他两个表没有，  
2、用字典的方法完成本表的汇总，三个表的所有数据都需汇总到"汇总"表。数据量很大3万多行，本表只列示几行，作为实验数据。数据量大，汇总只能用字典方法，但本人对字典不熟悉，请求坛里大神帮助。

zjzyj

Sub 出入库汇总()
t = Timer()
Dim ds, arr, brr, i, m, kk
x = Sheets("期初库存").Cells(Rows.Count, "A").End(xlUp).Row
x = x + Sheets("入库数据").Cells(Rows.Count, "D").End(xlUp).Row
ReDim brr(1 To x, 1 To 11)

Set ds = CreateObject("Scripting.Dictionary")  '

arr = Sheets("期初库存").[A1].CurrentRegion
For i = 2 To UBound(arr)
    kk = arr(i, 1) & "|" & arr(i, 2) & "|" & arr(i, 3)
    If kk <> "" Then
        If Not ds.exists(kk) Then
            m = ds.Count + 1
            ds(kk) = m
            brr(m, 1) = arr(i, 1)
            brr(m, 2) = arr(i, 2)
            brr(m, 3) = arr(i, 3)
        Else
            m = ds(kk)
        End If
        brr(m, 4) = brr(m, 4) + arr(i, 4)
        brr(m, 5) = brr(m, 5) + arr(i, 5)
    End If
Next

arr = Sheets("入库数据").[A1].CurrentRegion
For i = 2 To UBound(arr)
    kk = arr(i, 4) & "|" & arr(i, 5) & "|" & arr(i, 6)
    If kk <> "" Then
        If Not ds.exists(kk) Then
            m = ds.Count + 1
            ds(kk) = m
            brr(m, 1) = arr(i, 4)
            brr(m, 2) = arr(i, 5)
            brr(m, 3) = arr(i, 6)
        Else
            m = ds(kk)
        End If
        brr(m, 6) = brr(m, 6) + arr(i, 7)
        brr(m, 7) = brr(m, 7) + arr(i, 9)
    End If
Next

arr = Sheets("出库数据").[A1].CurrentRegion
For i = 2 To UBound(arr)
    kk = arr(i, 9) & "|" & arr(i, 10) & "|" & arr(i, 11)
    If kk <> "" Then
        If Not ds.exists(kk) Then
            m = ds.Count + 1
            ds(kk) = m
            brr(m, 1) = arr(i, 9)
            brr(m, 2) = arr(i, 10)
            brr(m, 3) = arr(i, 11)
        Else
            m = ds(kk)
        End If
        brr(m, 8) = brr(m, 8) + arr(i, 12)
        brr(m, 9) = brr(m, 9) + arr(i, 14)
    End If
Next

For i = 1 To ds.Count
    brr(i, 10) = brr(i, 4) + brr(i, 6) - brr(i, 8)
    brr(i, 11) = brr(i, 5) + brr(i, 7) - brr(i, 9)       '计算结存
Next

Sheets("汇总").[A1].CurrentRegion.Offset(1, 0).ClearContents
Sheets("汇总").[A2].Resize(ds.Count, 11) = brr
MsgBox "查询完成！" & Format(Timer() - t, "0.000") & " 秒"
End Sub

1007467564

非常感谢二楼zjzyj高人，圆满的解决了这个问题。