如何根据货币资金明细表中M列打勾的银行用VBA汇总到这个列表里

陈王宇翔

工作簿1.rar (66.07 KB, 下载次数: 11)

2024-1-28 09:53 上传

点击文件名下载附件

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.1.28
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     Set d1 = CreateObject("Scripting.Dictionary")
   
6.     Set Sh = ThisWorkbook.Sheets("列表")
   
7.     With Sheets("长短借款明细表")
   
8.         arr = .UsedRange
   
9.         For i = 9 To UBound(arr)
   
10.             s = arr(i, 1)
    
11.             If Not d1.exists(s) Then
    
12.                 d1(s) = Array(arr(i, 8), arr(i, 14), arr(i, 9), arr(i, 3), arr(i, 4))
    
13.             End If
    
14.         Next
    
15.     End With
    
16.     With Sheets("货币资金明细表")
    
17.         arr = .UsedRange
    
18.         For i = 9 To UBound(arr)
    
19.             If arr(i, 13) = "√" Then
    
20.                 m = m + 1
    
21.                 If Not d.exists(m) Then
    
22.                     d(m) = Array(arr(i, 3), arr(i, 1), arr(i, 2), arr(i, 6))
    
23.                 End If
    
24.             End If
    
25.         Next
    
26.     End With
    
27.     With Sh
    
28.         arr = .UsedRange
    
29.         For i = 3 To UBound(arr)
    
30.             s = Val(arr(i, 1))
    
31.             If d.exists(s) Then
    
32.                 arr(i, 3) = d(s)(0)
    
33.                 For j = 9 To 11
    
34.                     arr(i, j) = d(s)(j - 8)
    
35.                 Next
    
36.             Else
    
37.                 arr(i, 3) = ""
    
38.                 For j = 9 To 11
    
39.                     arr(i, j) = ""
    
40.                 Next
    
41.             End If
    
42.             s = arr(i, 9)
    
43.             If d1.exists(s) Then
    
44.                 arr(i, 6) = d1(s)(0)
    
45.                 arr(i, 7) = d1(s)(1)
    
46.                 For j = 12 To 14
    
47.                     arr(i, j) = d1(s)(j - 10)
    
48.                 Next
    
49.             Else
    
50.                 arr(i, 6) = ""
    
51.                 arr(i, 7) = ""
    
52.                 For j = 12 To 14
    
53.                     arr(i, j) = ""
    
54.                 Next
    
55.             End If
    
56.         Next
    
57.         .UsedRange = arr
    
58.     End With
    
59.     Application.ScreenUpdating = True
    
60.     MsgBox "OK！"
    
61. End Sub
    
62. 
    

复制代码

ykcbf1100

附件供参考。。。

陈王宇翔

ykcbf1100 发表于 2024-1-28 12:43
附件供参考。。。

谢谢老师，一次就解决了，感谢感谢。

陈王宇翔

ykcbf1100 发表于 2024-1-28 12:43
附件供参考。。。

老师，还想麻烦您一下，能否把基础表中的单位名称在点击提取时也加上来？谢谢了 工作簿1.rar (84.67 KB, 下载次数: 2)

2024-1-28 16:11 上传

点击文件名下载附件

ykcbf1100

陈王宇翔 发表于 2024-1-28 16:11
老师，还想麻烦您一下，能否把基础表中的单位名称在点击提取时也加上来？谢谢了

改好了。。。

cztanghao

用python自动提取并写入，参与一下：

陈王宇翔

cztanghao 发表于 2024-1-28 17:41
用python自动提取并写入，参与一下：

感谢你的帮助

cztanghao

陈王宇翔 发表于 2024-1-28 16:11
老师，还想麻烦您一下，能否把基础表中的单位名称在点击提取时也加上来？谢谢了

基础表在哪里，单位名称在哪里

陈王宇翔

cztanghao 发表于 2024-1-28 19:16
基础表在哪里，单位名称在哪里

已经搞定了，谢谢老师