求各位大佬怎么自动生成领料单

不闻z

想根据基础数据自动分项目生成领料单，需要填充在模板的内容包括A4单元格的项目名称和包装箱编号、数量，每个项目形成一个单独的SHEET,能否实现根据基础数据的行数自动生成的表自动增加相应的行数，求助各位大佬

不闻z

求大佬帮忙，非常感谢

gwjkkkkk

Option Explicit

Sub TEST1()
    Dim ar, br, cr, i&, j&, dic As Object, vKey, wks As Worksheet
   
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set dic = CreateObject("Scripting.Dictionary")
   
    For Each wks In Worksheets
        If InStr(",基础数据列表,领料模板,", "," & wks.Name & ",") = False Then wks.Delete
    Next
   
    ar = Worksheets("基础数据列表").[A1].CurrentRegion.Value
    For i = 2 To UBound(ar)
        dic(ar(i, 3)) = dic(ar(i, 3)) & " " & i
    Next i
   
    Set wks = Worksheets("领料模板")
    For Each vKey In dic.keys
        cr = Split(dic(vKey))
        ReDim br(1 To UBound(cr), 1 To 2)
        For i = 1 To UBound(cr)
            For j = 1 To 2
                br(i, j) = ar(cr(i), j)
            Next j
        Next i
        wks.Copy after:=Worksheets(Worksheets.Count)
        With ActiveSheet
            .Name = vKey
            .[A4].Value = vKey
            .[A9].Resize(UBound(br), 2) = br
        End With
    Next

    Set wks = Nothing
    Set dic = Nothing
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

..................

LIUZHU

参与下，效果

dambcer

拿去吧。。。。。。。。。。。。。。。。。。。。。。。。

LIUZHU

JS代码，供参考

1. function 领料单(){
   
2.         let obj=Sheets.Item("基础数据列表").UsedRange.Value2.slice(1).reduce((obj,[a,b,c])=>{
   
3.                 obj[c]=obj[c] || [];
   
4.                 return obj[c].push([a,b]), obj;
   
5.         },{});
   
6.         for (let key in obj){
   
7.                 Sheets.Item("领料模板").Copy(null,Sheets.Item(Sheets.Count));
   
8.                 ActiveSheet.Name=Range("a4").Value2=key;
   
9.                 Range("a9").Resize(obj[key].length,2).Value2=obj[key];
   
10.         }
    
11. }

复制代码

LIUZHU

附件，WPS测试有效，Excel不行

quqiyuan

参与一下，供参考。。。

sdytsxd991122