求大神通过VBA代码操作实现成绩表的插入

常扬帆

gwjkkkkk 发表于 2024-4-17 21:14
1.如果把原始一、原始二，变成一季度、二季度、三季度、四季度，又或一月、二月……12月的业绩，可能事先 ...

附上了附件，看怎么处理，麻烦您！

gwjkkkkk

常扬帆 发表于 2024-4-17 21:50
附上了附件，看怎么处理，麻烦您！

工号和姓名匹配不上，各表略有不同，按不同人进行处理

17687589358

1. Sub 合并成绩表()
   
2.     Dim sht1 As Worksheet, sht2 As Worksheet
   
3.     Dim c1%, r2%, c2%, c1z%, c2z%
   
4.     Set sht1 = Worksheets("原始1")
   
5.     Set sht2 = Worksheets("原始2")
   
6.    
   
7.     c1 = 3  '在原始1表中按奇数添加列
   
8.     c2 = 2  '原始2表中的循环字段列号
   
9.     r2 = sht2.Cells(sht2.Rows.Count, "C").End(xlUp).Row     '原始2表中的数据区域的最后行号
   
10.     c1z = sht1.Cells(1, sht2.Columns.Count).End(xlToLeft).Column '原始1表中的数据区域的最后列号
    
11.     c2z = sht2.Cells(1, sht2.Columns.Count).End(xlToLeft).Column '原始2表中的数据区域的最后列号
    
12. 
    
13.     Do
    
14.         If c1 > 2 * c1z - 1 Then c1 = c1 - 1
    
15.         sht1.Columns(c1).Insert shift:=xlShiftToRight
    
16.         sht2.Range(sht2.Cells(1, c2), sht2.Cells(r2, c2)).Copy Destination:=sht1.Cells(1, c1)
    
17.         c1 = c1 + 2
    
18.         c2 = c2 + 1
    
19.     Loop While c2 <= c2z
    
20.     Set sht1 = Nothing
    
21.     Set sht2 = Nothing
    
22.     c1 = 0: r2 = 0: c2 = 0: c1z = 0: c2z = 0
    
23. End Sub
    
24. 
    

复制代码

wcj6376tcp

gwjkkkkk 发表于 2024-4-17 23:05
工号和姓名匹配不上，各表略有不同，按不同人进行处理

非常不错，即使出现同名，工号不同也可以处理。厉害。