|
#2
阳光上的桥2023-03-23 09:16
浏览了你的代码，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 |
2.当CSV中物料编码为替代料时，向上寻找替代料到主料为止并添加，向下一行查找至替代料结束添加替代料
3.替代料栈位号与主料栈位号一致，栈位号=插槽后两位&子插槽。
4.
只有本站会员才能查看附件，请 登录
编号为流水号，替代料顺序添加不重复