求段VBA 代码

哈哈900

具体的要求的求助文件中。求大神们救命。
万分感谢~~~~~

哈哈900

可小偿。 大神救命。

蓝桥玄霜

提取的例子：

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.5.6
   
2.     Application.ScreenUpdating = False
   
3.     Set ws = ThisWorkbook
   
4.     Set sh = ThisWorkbook.Sheets("总表")
   
5.     p = ws.Path
   
6.     f = p & "\收入.xlsx"
   
7.     Set wb = Workbooks.Open(f, 0)
   
8.     ReDim brr(1 To 1, 1 To 12)
   
9.     On Error Resume Next
   
10.     With wb.Sheets("Dash_OOH")
    
11.         r = 32: c = 0
    
12.         For j = 14 To 28
    
13.             If InStr(.Cells(5, j), "月") Then
    
14.                 c = c + 1
    
15.                 If c = 1 Then
    
16.                     brr(1, 1) = .Cells(r, 14)
    
17.                 Else
    
18.                     brr(1, c) = brr(1, c - 1) + .Cells(r, j)
    
19.                 End If
    
20.             End If
    
21.         Next
    
22.     End With
    
23.     wb.Close False
    
24.     sh.Cells(24, "N").Resize(1, 12) = brr
    
25.     f = p & "\其他费用.xlsx"
    
26.     Set wb = Workbooks.Open(f, 0)
    
27.     With wb.Sheets(1)
    
28.         .[c3:n7].Copy sh.[n35]
    
29.         .[c14:n17].Copy sh.[n54]
    
30.     End With
    
31.     wb.Close False
    
32.     Application.ScreenUpdating = True
    
33.     MsgBox "OK！"
    
34. End Sub
    
35. 
    

复制代码

哈哈900

ykcbf1100 发表于 2024-5-6 15:21
参与一下。。。

感谢感谢。我先研究下。

哈哈900

ykcbf1100 发表于 2024-5-6 15:20
附件供参考。。。

感谢感谢。万分感谢。