VBA运行报错，大佬帮忙看一下

Sub dqysjSub()

Dim i, j, k, arr, flg, arrG2(), arrG3()

With Application.FileDialog(msoFileDialogFilePicker)

.Title = "请选择Leadtime、到店清单、工单明细源数据！" '选择窗口的标题

.InitialFileName = ThisWorkbook.Path '初次打开窗口的路径以及默认名称

.AllowMultiSelect = True '是否允许选择多个文件

.Filters.Clear '清除现有规则

.Filters.Add "EXCEL File", "*.xlsx; *.xls; *.xlsm", 1 '增加规则到第一位

If .Show Then '显示文件选择对话框

.ButtonName = "Select Me"

Set ipath = .SelectedItems '获取选择项,无论是否选择一项还是多项，返回的选项都是多项

End If

End With

If IsEmpty(ipath) Then Exit Sub '如果按取消键，退出

If ipath.Count <> 3 Then

MsgBox "请选择3个文件！" '对话框

Exit Sub

End If

arr = Array("Leadtime", "到店清单", "工单明细")

flg = Array(0, 0, 0)

For i = 1 To 3

'获取文件名

Filename = Split(ipath(i), "\")(UBound(Split(ipath(i), "\"))) '数组的最后一个元素为文件名（含后缀名）

If InStr(Filename, arr(0)) <> 0 Then

flg(0) = i

ElseIf InStr(Filename, arr(1)) <> 0 Then

flg(1) = i

ElseIf InStr(Filename, arr(2)) <> 0 Then

flg(2) = i

End If

Next

If flg(0) + flg(1) + flg(2) <> 6 Then

MsgBox "选择3个文件不是Leadtime、到店清单、工单明细源数据！" '对话框

Exit Sub

End If

'获取文件顺序

For i = 0 To 2

If InStr(Split(ipath(1), "\")(UBound(Split(ipath(1), "\"))), arr(i)) <> 0 Then

flg(i) = 1

ElseIf InStr(Split(ipath(2), "\")(UBound(Split(ipath(2), "\"))), arr(i)) <> 0 Then

flg(i) = 2

ElseIf InStr(Split(ipath(3), "\")(UBound(Split(ipath(3), "\"))), arr(i)) <> 0 Then

flg(i) = 3

End If

Next

On Error GoTo Erra

Set wL = Workbooks.Open(ipath(flg(0)))

Set wD = Workbooks.Open(ipath(flg(1)))

Set wG = Workbooks.Open(ipath(flg(2)))

On Error GoTo 0

'读取数据

'Leadtime

arrL = wL.Sheets(1).Range("a1:bd" & wL.Sheets(1).Range("a65536").End(xlUp).Row)

'到店清单

arrD = wD.Sheets(1).Range("a1:ax" & wD.Sheets(1).Range("a65536").End(xlUp).Row)

'工单明细

arrG = wG.Sheets(1).Range("a1:bq" & wG.Sheets(1).Range("a65536").End(xlUp).Row)

'关闭原始数据

wL.Close False '不保存

wD.Close False '不保存

wG.Close False '不保存

'计算数据

'arrD

'表头

arrD(1, 48) = "预约时段"

arrD(1, 49) = "到店时间差"

arrD(1, 50) = "客户等待分钟"

'内容

For j = 2 To UBound(arrD, 1)

If arrD(j, 17) <> "" Then

arrD(j, 17) = TimeValue(arrD(j, 17))

Select Case Hour(arrD(j, 17))

Case Is <= 8

arrD(j, 48) = "8-9WIP"

Case 9

arrD(j, 48) = "9-10WIP"

Case 10

arrD(j, 48) = "10-11WIP"

Case 11

arrD(j, 48) = "11-12WIP"

Case 12

arrD(j, 48) = "12-13WIP"

Case 13

arrD(j, 48) = "13-14WIP"

Case 14

arrD(j, 48) = "14-15WIP"

Case 15

arrD(j, 48) = "15-16WIP"

Case 16

arrD(j, 48) = "16-17WIP"

Case Else

arrD(j, 48) = "17-18WIP"

End Select

arrD(j, 19) = TimeValue(arrD(j, 19))

arrD(j, 49) = DateDiff("n", arrD(j, 17), arrD(j, 19))

End If

If arrD(j, 28) <> "" Then

arrD(j, 50) = (Val(Left(arrD(j, 28), 2)) * 60 * 60 + Val(Mid(arrD(j, 28), 4, 2)) * 60 + Val(Right(arrD(j, 28), 2))) / 60

End If

Next

'arrG

'提取SRP工时代码，维修类型，班组信息

arrDMCJY = ThisWorkbook.Sheets("SRP工时代码").Range("A1").CurrentRegion

arrDMSRP = ThisWorkbook.Sheets("SRP工时代码").Range("D1").CurrentRegion

arrWXLX = ThisWorkbook.Sheets("维修类型").Range("A1").CurrentRegion

arrBZXX = ThisWorkbook.Sheets("技师数据明细").Range("B1").CurrentRegion

'转字典

Set dicDMCJY = CreateObject("scripting.dictionary")

Set dicDMSRP = CreateObject("scripting.dictionary")

Set dicWXLX = CreateObject("scripting.dictionary")

Set dicBZXX = CreateObject("scripting.dictionary")

For j = 2 To UBound(arrDMCJY, 1)

If Not dicDMCJY.Exists(arrDMCJY(j, 1)) Then

dicDMCJY(arrDMCJY(j, 1)) = arrDMCJY(j, 2)

End If

Next j

For j = 2 To UBound(arrDMSRP, 1)

If Not dicDMSRP.Exists(arrDMSRP(j, 1)) Then

dicDMSRP(arrDMSRP(j, 1)) = arrDMSRP(j, 2)

End If

Next j

For j = 2 To UBound(arrWXLX, 1)

If Not dicWXLX.Exists(arrWXLX(j, 1)) Then

dicWXLX(arrWXLX(j, 1)) = arrWXLX(j, 2)

End If

Next j

For j = 2 To UBound(arrBZXX, 1)

If Not dicBZXX.Exists(arrBZXX(j, 1)) Then

dicBZXX(arrBZXX(j, 1)) = arrBZXX(j, 2)

End If

Next j

'表头

arrG(1, 65) = "纯机油"

arrG(1, 66) = "纯SRP"

arrG(1, 67) = "纯机电"

arrG(1, 68) = "PDI"

arrG(1, 69) = "班组"

NarrG2 = 0

'提取符合要求的数据加行号

For i = 2 To UBound(arrG, 1)

If arrG(i, 19) = "工时" And arrG(i, 34) <> "D-删除" And arrG(i, 39) <> "W 保修" And arrG(i, 39) <> "K Local BSI" Then

NarrG2 = NarrG2 + 1

ReDim Preserve arrG2(2, NarrG2 - 1)

arrG2(0, NarrG2 - 1) = i

arrG2(1, NarrG2 - 1) = arrG(i, 3)

arrG2(2, NarrG2 - 1) = arrG(i, 22)

End If

Next

'所有不重复单号,,首行

Set dicGDSH = CreateObject("scripting.dictionary")

For i = 0 To UBound(arrG2, 2)

If Not dicGDSH.Exists(arrG2(1, i)) Then

dicGDSH(arrG2(1, i)) = arrG2(0, i)

End If

Next

arrdicGDSHkeys = dicGDSH.Keys '所有不重复单号

For i = 0 To UBound(arrdicGDSHkeys)

''判断纯SRP

flg = 1

flgVHC = 0

For j = 0 To UBound(arrG2, 2)

If arrdicGDSHkeys(i) = arrG2(1, j) Then '单号相同

If Not dicDMSRP.Exists(arrG2(2, j)) Then

flg = 0

End If

If arrG2(2, j) <> "VHC" Then

flgVHC = 1

End If

End If

Next

If flg = 1 And flgVHC = 1 Then

arrG(dicGDSH(arrdicGDSHkeys(i)), 66) = 1

End If

'判断存机油

flg = 1

flgVHC = 0

For j = 0 To UBound(arrG2, 2)

If arrdicGDSHkeys(i) = arrG2(1, j) Then '单号相同

If Not dicDMCJY.Exists(arrG2(2, j)) Then

flg = 0

End If

If arrG2(2, j) <> "VHC" Then

flgVHC = 1

End If

End If

Next

If flg = 1 And flgVHC = 1 Then

arrG(dicGDSH(arrdicGDSHkeys(i)), 65) = 1

arrG(dicGDSH(arrdicGDSHkeys(i)), 66) = ""

End If

Next

'内容-存机电

NarrG3 = 0

'提取符合要求的数据加行号

For i = 2 To UBound(arrG, 1)

If arrG(i, 19) = "工时" And arrG(i, 34) <> "D-删除" Then

NarrG3 = NarrG3 + 1

ReDim Preserve arrG3(2, NarrG3 - 1)

arrG3(0, NarrG3 - 1) = i

arrG3(1, NarrG3 - 1) = arrG(i, 3)

arrG3(2, NarrG3 - 1) = arrG(i, 12)

End If

Next

'所有不重复单号,,首行

Set dicGDSH3 = CreateObject("scripting.dictionary")

For i = 0 To UBound(arrG3, 2)

If Not dicGDSH3.Exists(arrG3(1, i)) Then

dicGDSH3(arrG3(1, i)) = arrG3(0, i)

End If

Next

arrdicGDSHkeys3 = dicGDSH3.Keys '所有不重复单号

For i = 0 To UBound(arrdicGDSHkeys3)

''判断纯SRP

flgJD = 1

flgPDI = 1

For j = 0 To UBound(arrG3, 2)

If arrdicGDSHkeys3(i) = arrG3(1, j) Then '单号相同

If dicWXLX.Exists(arrG3(2, j)) Then

If dicWXLX(arrG3(2, j)) <> "机电" Then

flgJD = 0

End If

If dicWXLX(arrG3(2, j)) <> "PDI" Then

flgPDI = 0

End If

End If

End If

Next

If flgJD = 1 Then

arrG(dicGDSH3(arrdicGDSHkeys3(i)), 67) = 1

End If

If flgPDI = 1 Then

arrG(dicGDSH3(arrdicGDSHkeys3(i)), 68) = 1

End If

Next

'内容-班组

For i = 2 To UBound(arrG, 1)

If arrG(i, 25) <> "" Then

If dicBZXX.Exists(arrG(i, 25)) Then

arrG(i, 69) = dicBZXX(arrG(i, 25))

End If

End If

'工单明细工项代码转字符串

arrG(i, 22) = "'" & arrG(i, 22)

Next

'leadtime-源数据：从AN列开始，都是刷新以后计算的结果，并且带出列名

arrL(1, 40) = "当天结算" 'AN

arrL(1, 41) = "进厂时段" 'AO

arrL(1, 42) = "结账时段" 'AP

arrL(1, 43) = "纯机油" 'Aq-at

arrL(1, 44) = "纯SRP"

arrL(1, 45) = "纯机电"

arrL(1, 46) = "PDI"

arrL(1, 47) = "纯机油58min"

arrL(1, 48) = "服务时长"

arrL(1, 49) = "进厂-开工"

arrL(1, 50) = "开工-完工"

arrL(1, 51) = "完工-结算"

arrL(1, 52) = "wip重复标记"

arrL(1, 53) = "班组"

arrL(1, 54) = "进厂-开工"

arrL(1, 55) = "完工-出厂"

arrL(1, 56) = "当日调度出厂"

For i = 2 To UBound(arrL, 1)

'AN

If arrL(i, 14) = arrL(i, 32) Then

arrL(i, 40) = 1

End If

'AO

If arrL(i, 15) <> "" Then

arrL(i, 15) = TimeValue(arrL(i, 15))

Select Case Hour(arrL(i, 15))

Case Is <= 8

arrL(i, 41) = "8-9WIP"

Case 9

arrL(i, 41) = "9-10WIP"

Case 10

arrL(i, 41) = "10-11WIP"

Case 11

arrL(i, 41) = "11-12WIP"

Case 12

arrL(i, 41) = "12-13WIP"

Case 13

arrL(i, 41) = "13-14WIP"

Case 14

arrL(i, 41) = "14-15WIP"

Case 15

arrL(i, 41) = "15-16WIP"

Case 16

arrL(i, 41) = "16-17WIP"

Case Else

arrL(i, 41) = "17-18WIP"

End Select

End If

'AP

If arrL(i, 33) <> "" Then

arrL(i, 33) = TimeValue(arrL(i, 33))

Select Case Hour(arrL(i, 33))

Case Is <= 8

arrL(i, 42) = "8-9WIP"

Case 9

arrL(i, 42) = "9-10WIP"

Case 10

arrL(i, 42) = "10-11WIP"

Case 11

arrL(i, 42) = "11-12WIP"

Case 12

arrL(i, 42) = "12-13WIP"

Case 13

arrL(i, 42) = "13-14WIP"

Case 14

arrL(i, 42) = "14-15WIP"

Case 15

arrL(i, 42) = "15-16WIP"

Case 16

arrL(i, 42) = "16-17WIP"

Case Else

arrL(i, 42) = "17-18WIP"

End Select

End If

'AQ-at

For j = 2 To UBound(arrG, 1)

If arrL(i, 2) = arrG(j, 3) Then

If arrG(j, 65) = 1 Then

arrL(i, 43) = 1

End If

If arrG(j, 66) = 1 Then

arrL(i, 44) = 1

End If

If arrG(j, 67) = 1 Then

arrL(i, 45) = 1

End If

If arrG(j, 68) = 1 Then

arrL(i, 46) = 1

End If

End If

Next

'AV

If arrL(i, 32) <> "" Then

arrL(i, 32) = CDate(arrL(i, 32)) 'AF

End If

If arrL(i, 33) <> "" Then

arrL(i, 33) = TimeValue(arrL(i, 33)) 'AG

End If

If arrL(i, 14) <> "" Then

arrL(i, 14) = CDate(arrL(i, 14)) 'N

End If

If arrL(i, 15) <> "" Then

arrL(i, 15) = TimeValue(arrL(i, 15)) 'O

End If

If arrL(i, 32) <> "" And arrL(i, 33) <> "" And arrL(i, 14) <> "" And arrL(i, 15) <> "" Then

arrL(i, 48) = DateDiff("s", arrL(i, 14) + arrL(i, 15), arrL(i, 32) + arrL(i, 33))

End If

'AU

If arrL(i, 43) = 1 And arrL(i, 48) < 3480 Then

arrL(i, 47) = 1

End If

'AW

If arrL(i, 17) <> "" And arrL(i, 18) <> "" And arrL(i, 14) <> "" And arrL(i, 15) <> "" Then 'Q-R

arrL(i, 17) = CDate(arrL(i, 17)) 'Q

arrL(i, 18) = TimeValue(arrL(i, 18)) 'R

arrL(i, 49) = DateDiff("s", arrL(i, 14) + arrL(i, 15), arrL(i, 17) + arrL(i, 18))

End If

'AX

If arrL(i, 17) <> "" And arrL(i, 18) <> "" And arrL(i, 19) <> "" And arrL(i, 20) <> "" Then 'Q-R S-T

arrL(i, 17) = CDate(arrL(i, 17)) 'Q

arrL(i, 18) = TimeValue(arrL(i, 18)) 'R

arrL(i, 19) = CDate(arrL(i, 19)) 'S

arrL(i, 20) = TimeValue(arrL(i, 20)) 'T

arrL(i, 50) = DateDiff("s", arrL(i, 17) + arrL(i, 18), arrL(i, 19) + arrL(i, 20))

End If

'AY

If arrL(i, 19) <> "" And arrL(i, 20) <> "" And arrL(i, 32) <> "" And arrL(i, 33) <> "" Then 'S-T

arrL(i, 19) = CDate(arrL(i, 19)) 'S

arrL(i, 20) = TimeValue(arrL(i, 20)) 'T

arrL(i, 51) = DateDiff("s", arrL(i, 19) + arrL(i, 20), arrL(i, 32) + arrL(i, 33))

End If

'az

WIP = 0

For j = i To 2 Step -1

If arrL(i, 2) = arrL(j, 2) Then

WIP = WIP + 1

End If

Next j

arrL(i, 52) = WIP

'技师1-5转班组

Set dicJs = CreateObject("scripting.dictionary")

For j = 2 To UBound(arrG, 1)

If arrL(i, 2) = arrG(j, 3) And arrG(j, 19) = "工时" Then

If Not dicJs.Exists(arrG(j, 25)) Then

dicJs(arrG(j, 25)) = ""

End If

End If

Next j

arrJS = dicJs.Keys

For j = 0 To UBound(arrJS)

If dicBZXX.Exists(arrJS(j)) Then

arrJS(j) = dicBZXX(arrJS(j))

End If

Next j

arrL(i, 53) = Join(arrJS, "_")

'BB列54：列名：进厂-开工：（Q+R）-（N+O）上述几列要是空值或零都不要计算，以秒为单位

If arrL(i, 18) <> "" And arrL(i, 17) <> "" And arrL(i, 14) <> "" And arrL(i, 15) <> "" Then '（Q+R）-（N+O）

arrL(i, 18) = TimeValue(arrL(i, 18))

arrL(i, 17) = CDate(arrL(i, 17))

arrL(i, 14) = CDate(arrL(i, 14))

arrL(i, 15) = TimeValue(arrL(i, 15))

arrL(i, 54) = DateDiff("s", arrL(i, 14) + arrL(i, 15), arrL(i, 17) + arrL(i, 18))

End If

'BC列55：列名：完工-出厂：（W+X）-(S+T）上述几列要是空值或零都不要计算，以秒为单位

If arrL(i, 23) <> "" And arrL(i, 24) <> "" And arrL(i, 19) <> "" And arrL(i, 20) <> "" Then '（W+X）-(S+T）

arrL(i, 23) = CDate(arrL(i, 23))

arrL(i, 24) = TimeValue(arrL(i, 24))

arrL(i, 19) = CDate(arrL(i, 19))

arrL(i, 20) = TimeValue(arrL(i, 20))

arrL(i, 55) = DateDiff("s", arrL(i, 19) + arrL(i, 20), arrL(i, 23) + arrL(i, 24))

End If

'BD列：列名：当日调度出厂：N列=W列，标记1

If arrL(i, 14) <> "" And arrL(i, 23) <> "" Then

If arrL(i, 14) = arrL(i, 23) Then

arrL(i, 56) = 1

End If

End If

Next

'写入表格

'第一步清空

ThisWorkbook.Sheets("leadtime-源数据").UsedRange.ClearContents

ThisWorkbook.Sheets("E-reception到店清单-源数据").UsedRange.ClearContents

ThisWorkbook.Sheets("工单明细-源数据").UsedRange.ClearContents

'第二步写入Resize

ThisWorkbook.Sheets("leadtime-源数据").Range("a1").Resize(UBound(arrL, 1), UBound(arrL, 2)) = arrL

ThisWorkbook.Sheets("E-reception到店清单-源数据").Range("a1").Resize(UBound(arrD, 1), UBound(arrD, 2)) = arrD

ThisWorkbook.Sheets("工单明细-源数据").Range("a1").Resize(UBound(arrG, 1), UBound(arrG, 2)) = arrG

ThisWorkbook.Save

MsgBox "读取源数据并计算完成！"

Exit Sub

Erra: MsgBox "打来源数据失败！"

End Sub