请老师帮忙写一段关于数据汇总的代码

1105263341

盘点库存对比.rar (44.12 KB, 下载次数: 12)

2020-3-2 15:29 上传

点击文件名下载附件

请老师帮忙写一下代码，需要根据盘点工作表的货品编码跟颜色，去系统库存工作表中查找相同的货品跟颜色，然后用盘点工作表的尺码数量减去系统库存工作表中对应的尺码数量，最后结果显示在对比差异的工作表中。谢谢老师！

1588078/37

你这是服装或是鞋业的物流中转站吗

zh1518

Sub Test()
    Dim i, j, k, arr, brr, x, y
    arr = Sheet1.UsedRange '盘点表数据装入数组arr
    brr = Sheet2.UsedRange '系统库存数据装入数组brr
    ReDim crr(1 To UBound(arr), 1 To UBound(arr, 2)) '定义结果数组
   
   
    For i = 2 To UBound(arr)
        For j = 2 To UBound(brr)
            If arr(i, 1) & arr(i, 2) = brr(j, 1) & brr(j, 2) Then
                k = k + 1
                crr(k, 1) = arr(i, 1)
                crr(k, 2) = arr(i, 2)
                crr(k, 3) = arr(i, 3) - brr(j, 3)
                crr(k, 4) = arr(i, 4) - brr(j, 4)
                crr(k, 5) = arr(i, 5) - brr(j, 5)
                crr(k, 6) = arr(i, 6) - brr(j, 6)
                crr(k, 7) = arr(i, 7) - brr(j, 7)
                crr(k, 8) = arr(i, 8) - brr(j, 8)
                crr(k, 9) = arr(i, 9) - brr(j, 9)
                crr(k, 10) = arr(i, 10) - brr(j, 10)
                Exit For
            End If
        Next
    Next
    [2:10000] = ""
    Sheet3.[a2].Resize(k, 10) = crr
End Sub

3190496160

Sub test()
Set d = CreateObject("scripting.dictionary")
ar = Sheets("盘点").[a1].CurrentRegion
For i = 2 To UBound(ar)
    If Trim(ar(i, 1)) <> "" And Trim(ar(i, 2)) <> "" Then
        s = Trim(ar(i, 1)) & "|" & Trim(ar(i, 2))
        d(s) = i
    End If
Next i
br = Sheets("系统库存").[a1].CurrentRegion
For i = 2 To UBound(br)
     s_1 = Trim(br(i, 1)) & "|" & Trim(br(i, 2))
     m = d(s_1)
     If m <> "" Then
        ar(m, 10) = ar(m, 10) - br(i, 10)
    End If
Next i
With Sheets("对比差异")
    .UsedRange = Empty
    [a1].Resize(UBound(ar), UBound(ar, 2)) = ar
End With

End Sub

3190496160

盘点库存对比.rar (70.69 KB, 下载次数: 13)

2020-3-2 16:37 上传

点击文件名下载附件

1105263341

3190496160 发表于 2020-3-2 16:37

谢谢老师的帮助，问题圆满解决了。

1105263341

1588078/37 发表于 2020-3-2 15:56
你这是服装或是鞋业的物流中转站吗

这个是零售店用的，就是每个月盘点要比对差异。

1105263341

zh1518 发表于 2020-3-2 16:16
Sub Test()
    Dim i, j, k, arr, brr, x, y
    arr = Sheet1.UsedRange '盘点表数据装入数组arr

谢谢老师的热心帮助，帮我把问题圆满解决了。谢谢！

1105263341

3190496160 发表于 2020-3-2 16:37

老师您好,我发现如果系统库存工作表里面有的货号，但是盘点工作表里没有把这个货号盘进去，那么对比差异工作表里面应该把这个货号的尺码显示成负数，但是我们这个代码就直接没有显示这个货号了。能麻烦您帮我解决一下这个问题吗？Sub test()Set d = CreateObject("scripting.dictionary")
ar = Sheets("盘点").[a1].CurrentRegion
For i = 2 To UBound(ar)
    If Trim(ar(i, 1)) <> "" And Trim(ar(i, 2)) <> "" Then
        s = Trim(ar(i, 1)) & "|" & Trim(ar(i, 2))
        d(s) = i
    End If
Next i
br = Sheets("系统库存").[a1].CurrentRegion
For i = 2 To UBound(br)
     s_1 = Trim(br(i, 1)) & "|" & Trim(br(i, 2))
     m = d(s_1)
     If m <> "" Then
     ar(m, 3) = ar(m, 3) - br(i, 3)
     ar(m, 4) = ar(m, 4) - br(i, 4)
     ar(m, 5) = ar(m, 5) - br(i, 5)
     ar(m, 6) = ar(m, 6) - br(i, 6)
     ar(m, 7) = ar(m, 7) - br(i, 7)
     ar(m, 8) = ar(m, 8) - br(i, 8)
     ar(m, 9) = ar(m, 9) - br(i, 9)
     ar(m, 10) = ar(m, 10) - br(i, 10)
    End If
Next i
With Sheets("对比差异")
    .UsedRange = Empty
    [a1].Resize(UBound(ar), UBound(ar, 2)) = ar
End With

End Sub

1105263341

3190496160 发表于 2020-3-2 16:37

老师您好，我反复试了发现如果系统库存工作表中有的货号，但是盘点工作表中恰恰没有把这个货号录入进去，这个时候如果汇总的话，那么对比差异工作表中就应该显示这个货号所对应的尺码数量为负数，但是我们这个代码目前是不会显示这个货号的，还麻烦您帮我解决一下这个问题。谢谢！Sub test()
Set d = CreateObject("scripting.dictionary")
ar = Sheets("盘点").[a1].CurrentRegion
For i = 2 To UBound(ar)
    If Trim(ar(i, 1)) <> "" And Trim(ar(i, 2)) <> "" Then
        s = Trim(ar(i, 1)) & "|" & Trim(ar(i, 2))
        d(s) = i
    End If
Next i
br = Sheets("系统库存").[a1].CurrentRegion
For i = 2 To UBound(br)
     s_1 = Trim(br(i, 1)) & "|" & Trim(br(i, 2))
     m = d(s_1)
     If m <> "" Then
     ar(m, 3) = ar(m, 3) - br(i, 3)
     ar(m, 4) = ar(m, 4) - br(i, 4)
     ar(m, 5) = ar(m, 5) - br(i, 5)
     ar(m, 6) = ar(m, 6) - br(i, 6)
     ar(m, 7) = ar(m, 7) - br(i, 7)
     ar(m, 8) = ar(m, 8) - br(i, 8)
     ar(m, 9) = ar(m, 9) - br(i, 9)
     ar(m, 10) = ar(m, 10) - br(i, 10)
    End If
Next i
With Sheets("对比差异")
    .UsedRange = Empty
    [a1].Resize(UBound(ar), UBound(ar, 2)) = ar
End With

End Sub