[已解决]vba中在一个工作表中查找并返回另一个工作表的第一列相同数据，第二列不同数据

lhlprc · 发表于 2015-4-29 15:59

本帖最后由 lhlprc 于 2015-4-30 08:12 编辑

vba中在一个工作表中查找并返回另一个工作表的第一列相同数据，第二列不同数据
在做成绩表中，我需要将全年级总成绩表的数据按照班级返回到每一个班级成绩表中
我现在要在另一个工作表中返回1班的学生的所有数据，而不是一个人的数据

使用公式运算太慢了，容易死机
求教高手解答呀！急用。十分感谢！

最佳答案

月排行榜 / 总排行榜

grf1973

2015-4-30 15:19

Sub 生成()
Set d = CreateObject("scripting.dictionary")
Dim Bt As Range
arr = Sheet1.[a1].CurrentRegion
Set Bt = Sheet1.Range("a1:m2")
For i = 3 To UBound(arr)
bj = arr(i, 3)
If InStr(bj, "班") = 0 Then bj = bj & "班"
If Not d.exists(bj) Then
Set d(bj) = Union(Bt, Cells(i, 1).Resize(1, 13))
Else
Set d(bj) = Union(d(bj), Cells(i, 1).Resize(1, 13))
End If
Next
For Each dk In d.keys
Worksheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = dk
d(dk).Copy ActiveSheet.[a1]
Next
Sheet1.Activate
End Sub
Sub 删除()
Application.DisplayAlerts = False
For Each sh In Worksheets
If sh.Index > 1 Then sh.Delete
Next
Application.DisplayAlerts = True
End Sub

复制代码

跳转到最佳答案楼层

grf1973 · 发表于 2015-4-30 15:19

这个最佳答案由 grf1973 给出，感谢 grf1973 的回答。

单击隐藏图章

Sub 生成()
Set d = CreateObject("scripting.dictionary")
Dim Bt As Range
arr = Sheet1.[a1].CurrentRegion
Set Bt = Sheet1.Range("a1:m2")
For i = 3 To UBound(arr)
bj = arr(i, 3)
If InStr(bj, "班") = 0 Then bj = bj & "班"
If Not d.exists(bj) Then
Set d(bj) = Union(Bt, Cells(i, 1).Resize(1, 13))
Else
Set d(bj) = Union(d(bj), Cells(i, 1).Resize(1, 13))
End If
Next
For Each dk In d.keys
Worksheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = dk
d(dk).Copy ActiveSheet.[a1]
Next
Sheet1.Activate
End Sub
Sub 删除()
Application.DisplayAlerts = False
For Each sh In Worksheets
If sh.Index > 1 Then sh.Delete
Next
Application.DisplayAlerts = True
End Sub

复制代码

lhlprc · 发表于 2015-4-30 16:33

grf1973 发表于 2015-4-30 15:19

太感谢了，真是高手呀！！！！

		自动登录	找回密码
密码			注册

[已解决]vba中在一个工作表中查找并返回另一个工作表的第一列相同数据，第二列不同数据

相关帖子