求助如何做订单处理

月落天涯 · 发表于 2024-11-21 13:53

向各位大神求助如何做订单处理，希望达到的具体效果是：在订单统计表点击按钮后，自动统计订单明细表里所有物料的订单总量，对应的入库总量及需产数量，需产数量=订单总量-入库总量。订单总量需统计订单列表的数据才可得出，入库总量在月报表的F列，如果需产数量为负数或为零，则直接显示为零。已经模拟了数据。请大神帮忙，有鲜花。

loirol · 发表于 2024-11-21 14:30

是否存在同一品名两种规格

loirol · 发表于 2024-11-21 14:41

本帖最后由 loirol 于 2024-11-21 14:44 编辑

3190496160 · 发表于 2024-11-21 15:10

Sub 统计()
Application.ScreenUpdating = False
Dim ar As Variant, br As Variant
Dim i As Long, r As Long, rs As Long
Dim cr()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("订单明细")
r = .Cells(Rows.Count, 1).End(xlUp).Row
If r < 4 Then MsgBox "订单明细为空！": End
ar = .Range("a3:i" & r)
End With
With Sheets("月报表")
rs = .Cells(Rows.Count, 1).End(xlUp).Row
If rs < 4 Then MsgBox "月报表为空！": End
br = .Range("a3:j" & rs)
End With
ReDim cr(1 To UBound(ar), 1 To 9)
For i = 2 To UBound(ar)
If ar(i, 4) <> "" And ar(i, 5) <> "" Then
      s = ar(i, 4) & "|" & ar(i, 5)
      t = d(s)
      If t = "" Then
         k = k + 1
         d(s) = k
         t = k
         cr(k, 1) = k
         For j = 4 To 7
            cr(k, j - 2) = ar(i, j)
         Next j
         cr(k, 9) = ar(i, 9)
      End If
      cr(t, 6) = cr(t, 6) + ar(i, 8)
End If
Next i
For i = 2 To UBound(br)
If br(i, 1) <> "" And br(i, 2) <> "" Then
      s = br(i, 1) & "|" & br(i, 2)
      xh = d(s)
      If xh <> "" Then
         cr(xh, 7) = br(i, 6)
         cr(xh, 8) = IIf(cr(xh, 6) - cr(xh, 7) <= 0, 0, cr(xh, 6) - cr(xh, 7))
      Else
         cr(xh, 8) = cr(xh, 6)
      End If
End If
Next i
With Sheets("订单统计")
ws = .Cells(Rows.Count, 1).End(xlUp).Row
If ws > 3 Then
      .Range("a4:i" & ws).Borders.LineStyle = 0
      .Range("a4:i" & ws) = Empty
End If
.[a4].Resize(k, UBound(cr, 2)) = cr
.[a4].Resize(k, UBound(cr, 2)).Borders.LineStyle = 1
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160 · 发表于 2024-11-21 15:11

订单管理.rar (32.96 KB, 下载次数: 3)

Qs18 · 发表于 2024-11-21 15:51

Sub qs()
Dim arr, i, dic
Set dic = CreateObject("scripting.dictionary")
arr = Sheet4.Range("a4").CurrentRegion.Value
ReDim brr(1 To 1000, 1 To 9)
For i = 2 To UBound(arr)
s = arr(i, 4) & "|" & arr(i, 5) & "|" & arr(i, 6) & "|" & arr(i, 7)
If Not dic.exists(s) Then
m = m + 1
dic(s) = m
For j = 4 To 7
brr(m, j - 2) = arr(i, j)
Next
brr(m, 1) = m: brr(m, 6) = arr(i, 8)
Else
r = dic(s)
brr(r, 6) = brr(r, 6) + arr(i, 8)
End If
Next
crr = Sheet6.Range("a4").CurrentRegion.Value
For i = 2 To UBound(crr)
s = crr(i, 1) & "|" & crr(i, 2) & "|" & crr(i, 3) & "|" & crr(i, 4)
If dic.exists(s) Then
r = dic(s)
brr(r, 7) = crr(i, 6)
End If
Next
For i = 1 To m
brr(i, 8) = brr(i, 6) - brr(i, 7)
If brr(i, 8) < 0 Then brr(i, 8) = 0
Next
Sheet11.Range("a18").Resize(m, 9) = brr
Set dic = Nothing
End Sub

复制代码

Qs18 · 发表于 2024-11-21 15:52

Sub qs()
Dim arr, i, dic
Set dic = CreateObject("scripting.dictionary")
arr = Sheet4.Range("a4").CurrentRegion.Value
ReDim brr(1 To 1000, 1 To 9)
For i = 2 To UBound(arr)
s = arr(i, 4) & "|" & arr(i, 5) & "|" & arr(i, 6) & "|" & arr(i, 7)
If Not dic.exists(s) Then
m = m + 1
dic(s) = m
For j = 4 To 7
brr(m, j - 2) = arr(i, j)
Next
brr(m, 1) = m: brr(m, 6) = arr(i, 8)
Else
r = dic(s)
brr(r, 6) = brr(r, 6) + arr(i, 8)
End If
Next
crr = Sheet6.Range("a4").CurrentRegion.Value
For i = 2 To UBound(crr)
s = crr(i, 1) & "|" & crr(i, 2) & "|" & crr(i, 3) & "|" & crr(i, 4)
If dic.exists(s) Then
r = dic(s)
brr(r, 7) = crr(i, 6)
End If
Next
For i = 1 To m
brr(i, 8) = brr(i, 6) - brr(i, 7)
If brr(i, 8) < 0 Then brr(i, 8) = 0
Next
Sheet11.Range("a2").Resize(m, 9) = brr
Set dic = Nothing
End Sub

复制代码

Qs18 · 发表于 2024-11-21 15:54

试试...........

Qs18 · 发表于 2024-11-21 15:55

试试...........

月落天涯 · 发表于 2024-11-21 16:18

Qs18 发表于 2024-11-21 15:54
试试...........

非常感谢！

		自动登录	找回密码
密码			免费注册

[求助] 求助如何做订单处理

评分

评分

评分