高级excel2003 宏代码

Option Explicit

Sub 配件自动()
Dim a, b%, c$, d, e$, f$, g%, i%, newname$, arr1, arr2, arr3
a = Split(ActiveWorkbook.Name, "-")
b = a(LBound(a))
c = ActiveWorkbook.Name
arr1 = Array("022732", "022859", "022860", "025992", "027285", "027447", "027448", "027449", "028266", "028268", "028275", "028276", "028277", "028278", "031970")
arr2 = Array(1994, 1054, 1681, 2044, 2090, 843, 751, 947, 1277, 1463, 358, 560, 2, 167, 1842)
arr3 = Array(2043, 1276, 1842, 2089, 2122, 946, 842, 1053, 1462, 1680, 559, 750, 166, 357, 1993)
For i = 0 To UBound(arr)
If b = "S" + "022732" Then
Windows("SU 09合计总订单.xls").Activate
Application.Run "PERSONAL.XLS!配选5" & arr(i)
Windows(c).Activate
Application.Run "PERSONAL.XLS!市内配件"
Range("a2").FormulaR1C1 = "SU09沈阳360店4月配件"

newname = "d:\" + b + "SU09沈阳360店4月配件.xls"
Application.DefaultFilePath = False
ActiveWorkbook.SaveAs newname

d = Split(ActiveWorkbook.Name, ".")
e = d(LBound(d)) + ".xls"
f = Range("A4").End(xlToRight).Offset(1, 1).Address
g = Range(f).Column
Windows("SU 09合计总订单.xls").Activate
Sheets("市EQP").Select
Selection.AutoFilter Field:=54, Criteria1:="5" & arr(i)
Range("BD" & arr2(i)).Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-47],'[" & e & "]Sheet1'!C1:C" & g & "," & g & ",0)"
Range("BD" & arr2(i) & ":BD" & arr3(i)).Select
Selection.FillDown
Selection.AutoFilter Field:=56, Criteria1:="<>#N/A", Operator:=xlAnd
End If
Next
End Sub