[已解决]VBA同一工作表中根据条件判断复制单元格内容到相应单元格中

machaw

请教一下，如何使用VBA在同一工作表中判断A列中的每一个单元格内容是否在B列当中出现过，如果有，则将A列中该单元格内容复制到C列中对应行位置的单元格中，对于B列中未在A列里出现的内容，C列中A列有效行对应行号以下的地方开始复制……文字描述可能表达不是很清楚，具体可以看下附件，谢谢！

最佳答案

月排行榜 / 总排行榜

dsmch

2016-4-15 16:46

1. Sub Macro1()
   
2. Dim arr, brr, d, i&, j&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = [a4:a8]
   
5. brr = [g4:g9]
   
6. ReDim crr(1 To 20000, 1 To 1)
   
7. For i = 1 To UBound(arr)
   
8.     d(arr(i, 1)) = i
   
9. Next
   
10. n = d.Count
    
11. For i = 1 To UBound(brr)
    
12.     If d.exists(brr(i, 1)) Then
    
13.         crr(d(brr(i, 1)), 1) = brr(i, 1)
    
14.     Else
    
15.         n = n + 1
    
16.         crr(n, 1) = brr(i, 1)
    
17.         d(brr(i, 1)) = n
    
18.     End If
    
19. Next
    
20. [d4:d20000] = ""
    
21. Range("d4").Resize(n) = crr
    
22. End Sub

复制代码

跳转到最佳答案楼层

machaw

之前的附件有点问题，更新一下~

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, d, i&, j&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = [a4:a8]
   
5. brr = [g4:g9]
   
6. ReDim crr(1 To 20000, 1 To 1)
   
7. For i = 1 To UBound(arr)
   
8.     d(arr(i, 1)) = i
   
9. Next
   
10. n = d.Count
    
11. For i = 1 To UBound(brr)
    
12.     If d.exists(brr(i, 1)) Then
    
13.         crr(d(brr(i, 1)), 1) = brr(i, 1)
    
14.     Else
    
15.         n = n + 1
    
16.         crr(n, 1) = brr(i, 1)
    
17.         d(brr(i, 1)) = n
    
18.     End If
    
19. Next
    
20. [d4:d20000] = ""
    
21. Range("d4").Resize(n) = crr
    
22. End Sub

复制代码

machaw

dsmch 发表于 2016-4-15 16:46

多谢！另外，再请教一下，如果A列和G列行数不确定的话……
arr = [a4:a20]
brr = [g4:g9]
这里在a20和g9处使用变量来代替的话可以么，是要怎么使用呢？谢谢！

machaw

machaw 发表于 2016-4-15 18:17
多谢！另外，再请教一下，如果A列和G列行数不确定的话……
arr = [a4:a20]
brr = [g4:g9]

啊！……多谢！