代码运行后 其他单元格的求和公式被清除

维叶

这样修改一下，你试下可以不

维叶

1. Sub 主营业务收支汇总()
   
2.   
   
3.   Application.ScreenUpdating = False
   
4.   Application.DisplayAlerts = False
   
5.   Dim sht As Worksheet
   
6.   Dim arr1, arr2, arr3, brr
   
7.   Dim d1, d2, d3
   
8.   Set d1 = CreateObject("scripting.dictionary")
   
9.   Set d2 = CreateObject("scripting.dictionary")
   
10.   Set d3 = CreateObject("scripting.dictionary")
    
11.   strPath = ThisWorkbook.Path & ""
    
12.   With Application.FileDialog(1)
    
13.         With .Filters
    
14.           .Clear
    
15.           .Add "Excel Files", "*.xlsx"
    
16.         End With
    
17.   .AllowMultiSelect = True
    
18.   .InitialFileName = strPath
    
19.   If .Show Then Set Items = .SelectedItems Else Exit Sub
    
20.   End With
    
21. For Each vitem In Items
    
22.     With GetObject(vitem)
    
23.     If InStr(vitem, "2024年A-B请款单【开采】") Then
    
24.           For Each sht In .Sheets
    
25.           lie = sht.UsedRange.Find("金额/元").Column
    
26.           hang = sht.[a1:a1000].Find("合计").Row
    
27.           d1(sht.Name & "月") = Array(Val(Format(sht.Cells(hang, lie), "0.00")), _
    
28.           Val(Format(sht.Cells(hang, lie + 1), "0.00")), _
    
29.            Val(Format(sht.Cells(hang, lie + 2), "0.00")))
    
30.           Next
    
31.      End If
    
32.         If InStr(vitem, "2024年B-C请款单【开采&机械】") Then
    
33.         For Each sht In .Sheets
    
34.         lie = sht.UsedRange.Find("金额/元").Column
    
35.         hang = sht.[a1:a1000].Find("合计").Row
    
36.         d2(sht.Name & "月") = Array(Val(Format(sht.Cells(hang, lie), "0.00")), _
    
37.         Val(Format(sht.Cells(hang, lie + 1), "0.00")), _
    
38.         Val(Format(sht.Cells(hang, lie + 2), "0.00")))
    
39.         Next
    
40.       End If
    
41.      If InStr(vitem, "2024年B-车队请款【运输】") Then
    
42.         For Each sht In .Sheets
    
43.         lie = sht.UsedRange.Find("金额").Column
    
44.         hang = sht.[a1:a1000].Find("总计").Row
    
45.         d3(sht.Name & "月") = sht.Cells(hang, lie)
    
46.         Next
    
47.       End If
    
48.     End With
    
49.   Next
    
50.     With ThisWorkbook.Sheets("主营业务利润表")
    
51.         For x = 3 To 14
    
52.              s = .Cells(x, 1).Value
    
53.               If d1.exists(s) Then
    
54.               .Cells(x, 2) = d1(s)(0)
    
55.                .Cells(x, 3) = d1(s)(1)
    
56.                .Cells(x, 4) = d1(s)(2)
    
57.               End If
    
58.         Next
    
59.         .[b15].Resize(1, 3).FormulaR1C1 = "=SUM(R3C:R[-1]C)"
    
60.    
    
61.         For x = 20 To 31
    
62.               s = .Cells(x, 1).Value
    
63.             If d2.exists(s) Then
    
64.              .Cells(x, 2) = d2(s)(0)
    
65.              .Cells(x, 3) = d2(s)(1)
    
66.             .Cells(x, 4) = d2(s)(2)
    
67.             End If
    
68.          
    
69.             If d3.exists(s) Then
    
70.             .Cells(x, 7) = d3(s)
    
71.             End If
    
72.         Next
    
73.         .[b32].Resize(1, 7).FormulaR1C1 = "=SUM(R20C:R[-1]C)"
    
74. End With
    
75.   MsgBox "ok!"
    
76.   Application.DisplayAlerts = True
    
77.   Application.ScreenUpdating = True
    
78. End Sub

复制代码

为什么之前的还不显示呢？审核时间也太长了吧

半百

了却无痕 发表于 2024-1-12 10:18
大神 这个咋弄哩

月份在A列，应该跟上边的一样也是1，为什么写成20？

了却无痕

维叶 发表于 2024-1-12 15:14

大神早上好 目前是出现了这个情况

收入可以正常保留公式了 但是支出还是不可以 麻烦您帮我看看

了却无痕

维叶 发表于 2024-1-12 15:58
为什么之前的还不显示呢？审核时间也太长了吧

大神，你好 代码可以成功运行了 很厉害
但是可以选择文件夹吗？你这个是具体到表格了 有点不方便呀

维叶

了却无痕 发表于 2024-1-15 10:09
大神，你好 代码可以成功运行了 很厉害
但是可以选择文件夹吗？你这个是具体到表格了 有点不方便呀

你的程序本来就是选择文件的啊，我没有修改，只是修改了点写入单元格，不覆盖你的公式而已，你说的不方便指什么，不明白

了却无痕

维叶 发表于 2024-1-15 15:38
你的程序本来就是选择文件的啊，我没有修改，只是修改了点写入单元格，不覆盖你的公式而已，你说的不方便 ...

这样子吗 好的 那谢谢大佬了