物料对应，把表1-表2=表3

15968725770

物料对应，把表1-表2=表3

3190496160

Sub test()
Application.ScreenUpdating = False
Dim ar As Variant
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("表1")
    r1 = .Cells(Rows.Count, 1).End(xlUp).Row
    ar = .Range("a1:ae" & r1)
End With
With Sheets("表2")
    r2 = .Cells(Rows.Count, 1).End(xlUp).Row
    br = .Range("a1:ae" & r2)
End With

With Sheets("表3")
    r3 = .Cells(Rows.Count, 1).End(xlUp).Row
    If r3 < 12 Then MsgBox "表3为空！": End
    .Range("ae12:ae" & r3) = Empty
    cr = .Range("a11:ae" & r3)
    For i = 2 To UBound(cr)
        If Trim(cr(i, 1)) <> "" Then
            d(Trim(cr(i, 1))) = i
        End If
    Next i
    For i = 2 To UBound(ar)
        If Trim(ar(i, 1)) <> "" Then
            xh = d(Trim(ar(i, 1)))
            If xh <> "" Then
                cr(xh, 31) = cr(xh, 31) + ar(i, 31)
            End If
        End If
    Next i
    For i = 2 To UBound(br)
        If Trim(br(i, 1)) <> "" Then
            xh = d(Trim(br(i, 1)))
            If xh <> "" Then
                cr(xh, 31) = cr(xh, 31) - br(i, 31)
            End If
        End If
    Next i
    .Range("ae11:ae" & r3) = Application.Index(cr, 0, 31)
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

3190496160

物料对应，把表1-表2=表3.rar (21.16 KB, 下载次数: 10)

2023-2-18 09:33 上传

点击文件名下载附件

luikias

3190496160 发表于 2023-2-18 09:33

一大早就帮论坛解决问题！

qdtzq

物料对应，把表1-表2=表3