|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
以下代码,在32位EXCEL运行中能正常执行,但换成64位EXCEL后,运行是会随机中断在wb.close true,系统是WIN10 64位,excel版本是365,请老师们帮忙看看怎么解决,谢谢
sub feiyongchaifen()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim wb As Workbook
Dim dic As Object
Dim dic1 As Object
k = Sheets("预算部门").Range("g2").End(xlDown).Row '部门的最后一行
For i = 2 To k '此为最外层的循环,为的是另存出每一个部门
t = Sheets("预算部门").Range("g" & i) '外层循环部门名称
t1 = Sheets("预算部门").Range("h" & i) '外层循环部门索引
ActiveWorkbook.SaveCopyAs Filename:=ThisWorkbook.Path & "\【" & t1 & "-" & t & "】2023部门预算.xlsm"
Set wb = Workbooks.Open(ThisWorkbook.Path & "\【" & t1 & "-" & t & "】2023部门预算.xlsm")
n = 0
For i1 = 2 To k '此为内层循环,为的是取本部门的下一级部门(不含下下级部门),及部门汇总中列示的部门
'下级部门数量
tt1 = wb.Sheets("预算部门").Range("h" & i1) '内循环的部门索引
If Left(tt1, Len(t1)) * 1 = t1 * 1 And Len(tt1) - Len(t1) = 2 Then '条件是内层循环的部门代码等于外层循环部门,且部门代码的位数差是2位的
n = n + 1
wb.Sheets("部门汇总").Cells(3, 13 + n) = wb.Sheets("预算部门").Range("g" & i1) '部门汇总增加下级部门名称
nm = wb.Sheets("预算部门").Range("g" & i1)
wb.Sheets("月度").Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = nm
ActiveSheet.Range("i2") = wb.Sheets("预算部门").Range("g" & i1)
Set dic = CreateObject("scripting.dictionary")
For k2 = 2 To Sheets("费用明细").Range("av2").End(xlDown).Row '费用明细的最后一行
If Left(wb.Sheets("费用明细").Range("bm" & k2), Len(tt1)) * 1 = tt1 * 1 Then
dic(wb.Sheets("费用明细").Range("aw" & k2).Value) = dic(wb.Sheets("费用明细").Range("aw" & k2).Value) + wb.Sheets("费用明细").Range("au" & k2).Value
End If
Next k2
For k1 = 4 To 56
wb.Sheets(nm).Range("j" & k1) = dic(wb.Sheets(nm).Range("a" & k1).Value)
Next k1
End If
Next i1
Set dic1 = CreateObject("scripting.dictionary")
For k2 = 2 To Sheets("费用明细").Range("av2").End(xlDown).Row '费用明细的最后一行
If Left(wb.Sheets("费用明细").Range("bm" & k2), Len(t1)) * 1 = t1 * 1 Then
dic1(wb.Sheets("费用明细").Range("aw" & k2).Value) = dic1(wb.Sheets("费用明细").Range("aw" & k2).Value) + wb.Sheets("费用明细").Range("au" & k2).Value
End If
Next k2
For k1 = 4 To 56
wb.Sheets("月度").Range("j" & k1) = dic1(wb.Sheets("月度").Range("a" & k1).Value)
Next k1
wb.Sheets("费用明细").Delete
wb.Sheets("预算部门").Delete
wb.Sheets("月度").Activate
wb.Sheets("月度").Range("i2").Select
wb.Sheets("月度").Range("i2") = t
' wb.Save
wb.Close True
Next i
MsgBox "运行完毕"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
|
|