如何多表分类明细汇总显示？请哪位老师帮助解决一下，谢谢！

tlq1879

一把小刀闯天下 发表于 2019-3-15 12:01
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

如何在选取A1单元格的银行后，通过函数或VBA将在职工资、退休工资和离休工资三个表中的代发银行是A1的人员姓名、实发金额信息自动显示在本表中，并加上序号。谢谢！

一把小刀闯天下

tlq1879 发表于 2019-3-16 09:15
如何在选取A1单元格的银行后，通过函数或VBA将在职工资、退休工资和离休工资三个表中的代发银行是A1的人 ...

和一楼的要求完全一样，，，

tlq1879

一把小刀闯天下 发表于 2019-3-16 10:38
和一楼的要求完全一样，，，

这个列数不一样，麻烦您给修改下，初学一些东西还研究分析不了。谢谢

lsc900707

tlq1879 发表于 2019-3-16 15:58
这个列数不一样，麻烦您给修改下，初学一些东西还研究分析不了。谢谢

这样的问题自己要学会变通，否则难得有进步！也凑个热闹写一个：

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Dim brr(1 To 99999, 1 To 4)
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     If Target.Address = "$A$1" Then
   
5.         For Each sht In Sheets
   
6.             If InStr(sht.Name, "工资") Then
   
7.                 arr = sht.[a1].CurrentRegion
   
8.                 For i = 2 To UBound(arr)
   
9.                     If arr(i, 6) = Target Then
   
10.                         m = m + 1
    
11.                         brr(m, 1) = m: brr(m, 2) = arr(i, 4): brr(m, 3) = arr(i, 7)
    
12.                         For j = 6 To UBound(arr, 2)
    
13.                             If arr(1, j) = "实发合计" Then
    
14.                                 brr(m, 4) = arr(i, j): sum = sum + arr(i, j)
    
15.                             End If
    
16.                         Next
    
17.                     End If
    
18.                 Next
    
19.             End If
    
20.         Next
    
21.         m = m + 1: brr(m, 1) = "合计": brr(m, 4) = sum
    
22.         If m > 0 Then
    
23.             [a1].CurrentRegion.Offset(2).Clear
    
24.             [a3].Resize(m, 4) = brr
    
25.             [a3].Resize(m, 4).Borders.LineStyle = 1
    
26.         End If
    
27.     End If
    
28. End Sub

复制代码

tlq1879

lsc900707 发表于 2019-3-16 16:52
这样的问题自己要学会变通，否则难得有进步！也凑个热闹写一个：

谢谢老师的指教，不过这个银行账号长的话就成了科学计数格式，不是文本格式。

lsc900707

tlq1879 发表于 2019-3-16 17:52
谢谢老师的指教，不过这个银行账号长的话就成了科学计数格式，不是文本格式。

代码23行后面加多一句：
    Columns(3).NumberFormatLocal = "@"