1.CSV中的元件从BOM中获取替代料与元件名称，BOM中第11列、12列、15列空值时为上一行的替代料。
2.当CSV中物料编码为替代料时，向上寻找替代料到主料为止并添加，向下一行查找至替代料结束添加替代料
3.替代料栈位号与主料栈位号一致，栈位号=插槽后两位&子插槽。
4. 编号为流水号，替代料顺序添加不重复

浏览了你的代码，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