| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 611 人关注过本帖
标题:求大神帮我添砖加瓦,一个师傅没有完成的事业,我复制粘贴了一下哈差一点点
只看楼主 加入收藏
Birrgit
Rank: 1
等 级:新手上路
帖 子:2
专家分:0
注 册:2023-3-19
收藏
 问题点数:0 回复次数:1 
求大神帮我添砖加瓦,一个师傅没有完成的事业,我复制粘贴了一下哈差一点点
1.CSV中的元件从BOM中获取替代料与元件名称,BOM中第11列、12列、15列空值时为上一行的替代料。
2.当CSV中物料编码为替代料时,向上寻找替代料到主料为止并添加,向下一行查找至替代料结束添加替代料
3.替代料栈位号与主料栈位号一致,栈位号=插槽后两位&子插槽。
4.
一键导入制作站位表.rar (30.48 KB)
编号为流水号,替代料顺序添加不重复
搜索更多相关主题的帖子: 复制 师傅 事业  添加 
2023-03-19 21:28
阳光上的桥
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:38
帖 子:129
专家分:772
注 册:2023-1-12
收藏
得分:0 
浏览了你的代码,100多行了,很不错的,我粘贴一份在下面,以供其他人查看方便,你有具体问题可以针对性的讨论。

程序代码:
Sub 制作站位表()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim F, i, n, ar, arr, brr(1 To 5000, 1 To 8), wb As Workbook, rng As Range, d As Object, sht As Worksheet
    Set d = CreateObject("scripting.dictionary")
    F = Application.GetOpenFilename("导入BOM,*.xlsx;*.xls", MultiSelect:=True)
    Set wb = Workbooks.Open(F(1))
    ar = ActiveSheet.UsedRange
    wb.Close False
    F = Application.GetOpenFilename("导入站位表文件,*.csv", MultiSelect:=True)
    Set wb = Workbooks.Open(F(1))
    arr = ActiveSheet.UsedRange
    wb.Close False
    For i = 7 To UBound(arr) '机器名
        If arr(i, 1) <> "" Then d(Val(arr(i, 1))) = ""
    Next
    For Each sht In Sheets
        If sht.Name <> "站位表工具" Then sht.Delete
    Next
    For K = 0 To d.Count - 1
        For i = 7 To UBound(arr)
            If arr(i, 1) = d.keys()(K) And arr(i, 3) <> "2" And arr(i, 6) <> "" Then
                n = n + 1
                brr(n, 1) = n '序号
                If arr(i, 5) <> "" Then
                    brr(n, 2) = Right(arr(i, 4), 2) & "-" & arr(i, 5) '栈位号
                Else
                    brr(n, 2) = Right(arr(i, 4), 2) '栈位号
                End If
                brr(n, 3) = Left(arr(i, 6), 10) '物料编码
                brr(n, 5) = arr(i, 8) '飞达规格
                If arr(i, 12) <> "" Then
                    brr(n, 8) = arr(i, 12)  '位号
                    brr(n, 7) = UBound(Split(arr(i, 12), ",")) + 1 '用量
                End If
                If arr(i, 13) <> "" Then
                    brr(n, 8) = arr(i, 13)  '位号
                    brr(n, 7) = UBound(Split(arr(i, 13), ",")) + 1 '用量
                End If
                For r = 8 To UBound(ar)
                    If ar(r, 2) = brr(n, 3) Then
                        brr(n, 4) = ar(r, 5) '元件名称
                        If ar(r, 11) <> "" Then
                            brr(n, 6) = "Y" '是否主料
                        Else
                            brr(n, 6) = "N"
                        End If
                    End If
                Next
            End If
        Next
        Rows("6:5000").Delete
        [A6].Resize(UBound(brr), 8) = brr
        n = 0: Erase brr
        '        Range("a6:h" & [a65536].End(3).Row).HorizontalAlignment = Excel.xlCenter '左右居中
        '        Range("a6:h" & [a65536].End(3).Row).VerticalAlignment = xlCenter '上下居中
        Range("a6:h" & [a65536].End(3).Row).Borders.LineStyle = xlContinuous '添加边框
        Sheets("站位表工具").Copy after:=Sheets(Sheets.Count)
        ActiveSheet.Shapes.Range(Array("Button 1")).Delete
        ActiveSheet.Name = "机台" & d.keys()(K) & "-TAB1"
     Next
    For M = 0 To d.Count - 1
        For i = 7 To UBound(arr)
            If arr(i, 1) = d.keys()(M) And arr(i, 3) <> "2" And arr(i, 6) <> "" Then
                n = n + 1
                brr(n, 1) = n '序号
                If arr(i, 5) <> "" Then
                    brr(n, 2) = Right(arr(i, 4), 2) & "-" & arr(i, 5) '栈位号
                Else
                    brr(n, 2) = Right(arr(i, 4), 2) '栈位号
                End If
                brr(n, 3) = Left(arr(i, 6), 10) '物料编码
                brr(n, 5) = arr(i, 8) '飞达规格
                If arr(i, 12) <> "" Then
                    brr(n, 8) = arr(i, 12)  '位号
                    brr(n, 7) = UBound(Split(arr(i, 12), ",")) + 1 '用量
                End If
                If arr(i, 13) <> "" Then
                    brr(n, 8) = arr(i, 13)  '位号
                    brr(n, 7) = UBound(Split(arr(i, 13), ",")) + 1 '用量
                End If
                For r = 8 To UBound(ar)
                    If ar(r, 2) = brr(n, 3) Then
                        brr(n, 4) = ar(r, 5) '元件名称
                        If ar(r, 11) <> "" Then
                            brr(n, 6) = "Y" '是否主料
                        Else
                            brr(n, 6) = "N"
                        End If
                    End If
                Next
            End If
        Next
        Rows("6:1000").Delete
        [A6].Resize(UBound(brr), 8) = brr
        n = 0: Erase brr
        '        Range("a6:h" & [a65536].End(3).Row).HorizontalAlignment = Excel.xlCenter '左右居中
        '        Range("a6:h" & [a65536].End(3).Row).VerticalAlignment = xlCenter '上下居中
        Range("a6:h" & [a65536].End(3).Row).Borders.LineStyle = xlContinuous '添加边框
        Sheets("站位表工具").Copy after:=Sheets(Sheets.Count)
        ActiveSheet.Shapes.Range(Array("Button 1")).Delete
        ActiveSheet.Name = "机台" & d.keys()(M) & "-TAB2"

    Next
    MsgBox "站位表制作完成!", 48, "温馨提示"
End Sub
2023-03-23 09:16
快速回复:求大神帮我添砖加瓦,一个师傅没有完成的事业,我复制粘贴了一下哈差一 ...
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.046784 second(s), 9 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved