[已解决]姓名相同,提取后面的数据到另一个表格中,求VBA

wuliao_tao

详见附件
Book1.rar (1.88 KB, 下载次数: 256)

2012-3-24 10:19 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

1970-1-1 08:00

跳转到最佳答案楼层

hrpotter

1. Sub 提取()
   
2.     Dim d As Object
   
3.     Dim i As Integer
   
4.     Dim ar
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     Application.ScreenUpdating = False
   
7.     ar = Range("a2").CurrentRegion
   
8.     For i = 2 To UBound(ar)
   
9.         d(ar(i, 1)) = ar(i, 2)
   
10.     Next
    
11.     With Sheet2
    
12.         For i = 2 To .Range("a65536").End(xlUp).Row
    
13.             .Cells(i, 2) = d(.Cells(i, 1).Value)
    
14.         Next
    
15.     End With
    
16.     Application.ScreenUpdating = True
    
17. End Sub

复制代码

Book1.rar (7.52 KB, 下载次数: 328)

2012-3-24 10:46 上传

点击文件名下载附件

wuliao_tao

hrpotter 发表于 2012-3-24 10:46

如果SHEET1 A列中的姓名相同，如何实现金额相加
Book1.rar (8.25 KB, 下载次数: 108)

2012-4-25 11:08 上传

点击文件名下载附件

蓝桥玄霜

1. Sub 提取汇总()
   
2.     Dim d As Object
   
3.     Dim i As Integer
   
4.     Dim ar
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     Application.ScreenUpdating = False
   
7.     ar = Sheet1.Range("a2").CurrentRegion
   
8.     For i = 2 To UBound(ar)
   
9.         d(ar(i, 1)) = d(ar(i, 1)) + ar(i, 2)
   
10.     Next
    
11.     With Sheet2
    
12.         .[a2:b1000].Clear
    
13.         .[a2].Resize(d.Count) = Application.Transpose(d.keys)
    
14.         .[b2].Resize(d.Count) = Application.Transpose(d.items)
    
15.     End With
    
16.     Application.ScreenUpdating = True
    
17. End Sub
    

复制代码

wuliao_tao

蓝桥玄霜 发表于 2012-4-25 12:12

可能是我没有表述清楚，我的意思是：如果SHEET2中A列与SHEET1A列数据相同，就将SHEET1中的数据提取到SHEET2表中，而不提取SHEET1全有的数据汇总，还有就是，如果SHEET2对应SHEET1多个相同的数据，提取它的汇总金额


Book1.rar (1.99 KB, 下载次数: 71)

2012-4-27 23:19 上传

点击文件名下载附件

wuliao_tao

在線等．．．．．．．．

CD雪浪花

hrpotter 发表于 2012-3-24 10:46

您这代码提取姓名后面一列的数据是很好用的了，现要求提取后面多列数据，该怎样修改代码呢？请赐教，谢谢！