[已解决]用VBA找出目的表与源表相同人的信息，并删除源表内的人的信息。（要求有改动）

wxb120205

我的目的是想通过判断sheet2中的B列单元格中非空单元格中的某一单元格（如sheet2中的B3单元格）与sheet1中的B列单元格中的某一单元格内容(字符型)相同时(如与sheet1中的B27单元格相同),
既将sheet1表Range("C27:I27")区域的相对应的单元格内容粘贴到sheet2中相对应的（C3:I3）单元格区域内,并在sheet2中的G3单元格中的“类别”项内加入“夜考”，同时删除sheet1中的第Row27行。相关表格见附件，请各位高手老大帮忙，谢谢！！！请给出VBA程序，不能用函数“VlookUP”，因为用函数需要做两次太麻烦，也容易出错。

改了要求：（2014年5月20日）请注意黄底红字的内容！

我的目的是想通过判断sheet2中的B列单元格中非空单元格中的某一单元格（如sheet2中的B3单元格）与sheet1中的B列单元格中的某一单元格内容(字符型)相同时(如与sheet1中的B27单元格相同),
既将sheet1表Range("C27:I27")区域的相对应的单元格内容粘贴到sheet2中相对应的（C3:I3）单元格区域内，并在sheet1中的G27单元格中的“类别”项内加入“夜考”，全部找完并在sheet1中的G27单元格中的“类别”项内加入“夜考”后再按“夜考”项自动排序。相关表格见附件（在一楼的附件，谢谢！！！），请各位高手老大帮忙，谢谢！！！请给出VBA程序，不能用函数“VlookUP”，因为用函数需要做两次太麻烦，也容易出错。

补充：sheet2中B3单元格与Sheet1中B27单元格内容相同，接下来，拷贝Sheet1中C27:I27  到 sheet2中C3:I3，并在sheet1中的G27单元格中的“类别”项内加入“夜考”，全部找完并在sheet1中的G27单元格中的“类别”项内加入“夜考”后再按“夜考”项自动排序。

最佳答案

月排行榜 / 总排行榜

dsmch

2014-5-18 16:21

1. Sub Macro1()
   
2. Dim arr, brr, d, rng As Range, i&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. Sheets("Sheet2").Activate
   
5. With Sheets("Sheet1")
   
6. arr = .Range("a1").CurrentRegion
   
7. brr = Range("a1").CurrentRegion
   
8. For i = 3 To UBound(arr)
   
9.     d(arr(i, 2)) = i
   
10. Next
    
11. For i = 3 To UBound(brr)
    
12.     If brr(i, 2) <> "" And d.exists(brr(i, 2)) Then
    
13.         n = d(brr(i, 2))
    
14.         .Cells(n, 3).Resize(1, 7).Copy Cells(i, 3)
    
15.         Cells(i, "g") = "夜考"
    
16.         If rng Is Nothing Then Set rng = .Cells(n, 3) Else Set rng = Union(rng, .Cells(n, 3))
    
17.     End If
    
18. Next
    
19. If Not rng Is Nothing Then rng.EntireRow.Delete
    
20. End With
    
21. End Sub
    

复制代码

跳转到最佳答案楼层

wxb120205

补充：sheet2中B3单元格与Sheet1中B27单元格内容相同，接下来，拷贝Sheet1中C27:I27  到 sheet2中C3:I3,并在sheet2中的G3单元格内 加入“夜考”，同时删除sheet1中Row(27) 第27行。

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, d, rng As Range, i&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. Sheets("Sheet2").Activate
   
5. With Sheets("Sheet1")
   
6. arr = .Range("a1").CurrentRegion
   
7. brr = Range("a1").CurrentRegion
   
8. For i = 3 To UBound(arr)
   
9.     d(arr(i, 2)) = i
   
10. Next
    
11. For i = 3 To UBound(brr)
    
12.     If brr(i, 2) <> "" And d.exists(brr(i, 2)) Then
    
13.         n = d(brr(i, 2))
    
14.         .Cells(n, 3).Resize(1, 7).Copy Cells(i, 3)
    
15.         Cells(i, "g") = "夜考"
    
16.         If rng Is Nothing Then Set rng = .Cells(n, 3) Else Set rng = Union(rng, .Cells(n, 3))
    
17.     End If
    
18. Next
    
19. If Not rng Is Nothing Then rng.EntireRow.Delete
    
20. End With
    
21. End Sub
    

复制代码

dsmch

………………

wxb120205

感谢你的努力，我先下载看看，有需要改进的地方还要麻烦您。

wxb120205

改了要求：（2014年5月20日）请注意黄底红字的内容！

我的目的是想通过判断sheet2中的B列单元格中非空单元格中的某一单元格（如sheet2中的B3单元格）与sheet1中的B列单元格中的某一单元格内容(字符型)相同时(如与sheet1中的B27单元格相同),
既将sheet1表Range("C27:I27")区域的相对应的单元格内容粘贴到sheet2中相对应的（C3:I3）单元格区域内，并在sheet1中的G27单元格中的“类别”项内加入“夜考”，全部找完并在sheet1中的G27单元格中的“类别”项内加入“夜考”后再按“夜考”项自动排序。相关表格见附件（在一楼的附件，谢谢！！！），请各位高手老大帮忙，谢谢！！！请给出VBA程序，不能用函数“VlookUP”，因为用函数需要做两次太麻烦，也容易出错。

补充：sheet2中B3单元格与Sheet1中B27单元格内容相同，接下来，拷贝Sheet1中C27:I27  到 sheet2中C3:I3，并在sheet1中的G27单元格中的“类别”项内加入“夜考”，全部找完并在sheet1中的G27单元格中的“类别”项内加入“夜考”后再按“夜考”项自动排序。