【求助】按固定条件批量拆分成单个sheet（sheet页模版略有不同）

1084

1	根据“工资表数据”中的信息，按照银行类别进行套入
2	每个银行套入的模版有些许差别
3	人数约1000人
4	请大神指导

1084

烦请各位大神关注一下，当前一直是采用vlookup或数据透视方式操作，使用起来还是太麻烦了，可否帮忙写一个vba的方式，是否可以通过编程后控件点击一次性处理到位。
非常感谢~~~

hzruziniu

1. Sub yyyy()
   
2.     Dim arr, brr(), ar, r%, n%
   
3.     r = Range("a65536").End(3).Row
   
4.     arr = Range("a2:f" & r)
   
5.     ar = Array("建设银行", "苏宁银行", "农业银行")
   
6.     ReDim brr(1 To UBound(arr), 1 To 4)
   
7.     For Each kk In ar
   
8.         If kk = "建设银行" Or kk = "农业银行" Then
   
9.             For i = 1 To UBound(arr)
   
10.                 If arr(i, 3) = kk Then
    
11.                     n = n + 1
    
12.                     brr(n, 1) = n
    
13.                     brr(n, 2) = arr(i, 4)
    
14.                     brr(n, 3) = arr(i, 2)
    
15.                     brr(n, 4) = arr(i, 6)
    
16.                 End If
    
17.             Next
    
18.             s = kk & "工资模板"
    
19.             With Sheets(s)
    
20.                 .Cells(2, 1).Resize(n, 4) = brr
    
21.             End With
    
22.             n = 0
    
23.         End If
    
24.         If kk = "苏宁银行" Then
    
25.             For i = 1 To UBound(arr)
    
26.                 If arr(i, 3) = kk Then
    
27.                     n = n + 1
    
28.                     brr(n, 1) = arr(i, 4)
    
29.                     brr(n, 2) = arr(i, 2)
    
30.                     brr(n, 3) = arr(i, 6)
    
31.                     brr(n, 4) = "工资"
    
32.                 End If
    
33.             Next
    
34.             s = kk & "工资模板"
    
35.             With Sheets(s)
    
36.                 .Cells(2, 1).Resize(n, 4) = brr
    
37.             End With
    
38.             n = 0
    
39.         End If
    
40.     Next
    
41. End Sub
    

复制代码

hzruziniu

1求助：模版拆分.rar (16.65 KB, 下载次数: 27)

2018-9-28 17:53 上传

点击文件名下载附件

1084

您好，非常感谢您的帮助，刚刚在实际套入工资帐号测试时，出现了一个小问题：在套入实际帐号的时候，后续表格的格式发生了偏差。还请您帮忙看一下，谢谢。

1084

完成，谢谢各位大神无私的帮助。表格页略微调整，为了便于使用，另添加了拆分的按钮。