批量汇总领料单

Laughingsun889 · 发表于 2024-9-26 08:21

老师们，早！工作遇到的问题，解决不好，发上来请老师们帮忙！谢谢！CP开头的是产品编码，CL开头的是材料编码。CP0012是江总后的样本，是将对应产品的领料各天领料单的数量、金额列提取出来合并汇总到产品单中。代码放控制台中。具体看附件！

z865593849 · 发表于 2024-9-26 09:00

纯纯的体力活

ykcbf1100 · 发表于 2024-9-26 09:49

比较复杂，体力活啊

附件供参考。。。

ykcbf1100 · 发表于 2024-9-26 09:51

比较复杂，写起来费时。。。

Sub ykcbf() '//2024.9.26
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim tm: tm = Timer
Set fso = CreateObject("Scripting.FileSystemObject")
Set d = CreateObject("Scripting.Dictionary")
Set d1 = CreateObject("Scripting.Dictionary")
p = ThisWorkbook.Path & ""
p1 = p & "领料单"
p2 = p & "产品"
For Each f In fso.GetFolder(p1).Files
If LCase(f.Name) Like "*.xls*" Then
If InStr(f, "~$") = 0 Then
If InStr(f, ThisWorkbook.Name) = 0 Then
fn = fso.GetBaseName(f)
s = Replace(Split(fn, "-")(0), "领料", "")
Set wb = Workbooks.Open(f, 0)
arr = wb.Sheets(1).UsedRange
wb.Close 0
d1(s) = Array(arr(2, 4), arr(2, 6))
End If
End If
End If
Next
For Each k In d1.keys
d.RemoveAll
x = 0
ReDim brr(1 To 10000, 1 To 100)
m = 4: n = 7: bt = [{"数量","金额"}]
For Each f In fso.GetFolder(p1).Files
If LCase(f.Name) Like "*.xls*" Then
If InStr(f, "~$") = 0 Then
If InStr(f, ThisWorkbook.Name) = 0 Then
fn = fso.GetBaseName(f)
rq = Split(fn, "-")(1)
If InStr(fn, k) Then
If Not d.exists(rq) Then
n = n + 2
d(rq) = n
brr(4, n - 1) = bt(1)
brr(4, n) = bt(2)
brr(3, n - 1) = rq
End If
x = x + 1
Set wb = Workbooks.Open(f, 0)
arr = wb.Sheets(1).UsedRange
wb.Close 0
If x = 1 Then
For j = 1 To 6
brr(2, j) = arr(2, j)
brr(3, j) = arr(4, j)
Next
brr(3, 6) = "合计": brr(4, 6) = "数量": brr(4, 7) = "金额"
brr(2, 2) = k: brr(2, 4) = d1(k)(0): brr(2, 6) = d1(k)(1)
End If
For i = 5 To UBound(arr)
If Val(arr(i, 1)) Then
s = arr(i, 2)
If Not d.exists(s) Then
m = m + 1
d(s) = m
brr(m, 1) = m - 4
brr(m, 2) = s
brr(m, 3) = arr(i, 3)
brr(m, 4) = arr(i, 4)
brr(m, 5) = arr(i, 5)
End If
r = d(arr(i, 2))
brr(r, n - 1) = arr(i, 6)
brr(r, n) = arr(i, 8)
End If
Next
End If
End If
End If
End If
Next
Application.SheetsInNewWorkbook = 1
Set wb = Workbooks.Add
With wb.Sheets(1)
.[a2].Resize(1, n).Interior.ColorIndex = 6
.[a3].Resize(2, n).Interior.Color = 49407
.Name = k
With .[a1].Resize(m, n)
.Value = brr
.Borders.LineStyle = 1
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
.[a1].Resize(2, n).Borders.LineStyle = 0
For i = 5 To UBound(arr)
sum1 = 0: sum2 = 0
For j = 8 To n
If .Cells(4, j) = "数量" Then
sum1 = sum1 + .Cells(i, j).Value
End If
If .Cells(4, j) = "金额" Then
sum2 = sum2 + .Cells(i, j).Value
End If
Next
.Cells(i, 6).Value = sum1
.Cells(i, 7).Value = sum2
Next
For j = 6 To n Step 2
.Cells(3, j).Resize(, 2).Merge
Next
For j = 1 To 5
.Cells(3, j).Resize(2).Merge
Next
End With
wb.SaveAs p2 & k
wb.Close
Next
Set d = Nothing
Set d1 = Nothing
Application.ScreenUpdating = True
MsgBox "共用时：" & Format(Timer - tm) & "秒！"
End Sub

复制代码

Laughingsun889 · 发表于 2024-9-26 14:14

ykcbf1100 发表于 2024-9-26 09:51
比较复杂，写起来费时。。。

老师辛苦了！我自己琢磨了几天，没有搞成功，发上来请老师帮忙的！再次感谢！

Laughingsun889 · 发表于 2024-11-7 10:50

ykcbf1100 发表于 2024-9-26 09:51
比较复杂，写起来费时。。。

老师，早！这个编码，能正常运行，其功能是把实际领用材料数量和成本汇总起来，与BOM表成本对比。目前发现有两个问题：1、取提的数据不能对应该日的数据；2、取得的数不完整。我调试了几次也没有成功，麻烦老师抽空看看。谢谢！

ykcbf1100 · 发表于 2024-11-7 10:54

Laughingsun889 发表于 2024-11-7 10:50
老师，早！这个编码，能正常运行，其功能是把实际领用材料数量和成本汇总起来，与BOM表成本对比。目前发 ...

具体一点。。。

Laughingsun889 · 发表于 2024-11-7 11:06

ykcbf1100 发表于 2024-11-7 10:54
具体一点。。。

好的，我找出具体的数据，再麻烦你。我加了你的QQ可以吗？

ykcbf1100 · 发表于 2024-11-7 11:07

Laughingsun889 发表于 2024-11-7 11:06
好的，我找出具体的数据，再麻烦你。我加了你的QQ可以吗？

可以。。。

Laughingsun889 · 发表于 2024-11-7 11:20

ykcbf1100 发表于 2024-11-7 10:54
具体一点。。。

以CP0011的1月1日数据为例：
1、产品CP0011中有541、555、569等大数据，但CP0011领料中没有这些大数据。
2、合计数只计算到70行，71行至尾没有计算完。
麻烦老师看看。谢谢！

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

[求助] 批量汇总领料单

评分

评分