A、B列进行比较，并进行空行处理，谢谢taller、醉眼看尘世老师！

z865593849

lhj323323

taller 发表于 2024-10-3 14:15

老师

sKey，我可以定义为变体类型吗？

lhj323323

醉眼看尘世 发表于 2024-10-3 14:43
好久不用，练练手，怕忘了

写得好！

Option Compare Text
这一句，太关键了

测试成功，多谢老师！

ynzsvt

lhj323323 发表于 2024-10-3 14:29
什么意思？
我没看懂。

看线 ，这个就是交叉了，程序会出错的。

lhj323323

ynzsvt 发表于 2024-10-3 17:40
看线 ，这个就是交叉了，程序会出错的。

这两列数据源，是用同一VBA提取的，没想到还会有这种事发生
谢谢老师提醒！

lhj323323

ynzsvt 发表于 2024-10-3 17:40
看线 ，这个就是交叉了，程序会出错的。

老师：

我把两位老师的结果进行了验证
如下

hjd528

lhj323323 发表于 2024-10-4 06:40
老师：

我把两位老师的结果进行了验证

网上抄的代码，不知是否符合要求。

1. Sub 数据对比()
   
2. Dim arr, brr, crr
   
3. Dim i, j, n, lastrowA, lastrowB As Integer
   
4. 
   
5. '建立字典对象
   
6. Set d = CreateObject("scripting.dictionary")
   
7. 
   
8. '获取数据区域最后一行的行数
   
9. lastrowA = Sheets("两列数据对比").Cells(Rows.Count, 1).End(xlUp).Row
   
10. lastrowB = Sheets("两列数据对比").Cells(Rows.Count, 2).End(xlUp).Row
    
11. 
    
12. '将数据区域导入数组
    
13. arr = Sheets("两列数据对比").Range("A2:A" & lastrowA)
    
14. brr = Sheets("两列数据对比").Range("B2:B" & lastrowB)
    
15. 
    
16. '重新定义数组crr,数组行数：数组arr+数组brr元素数和，列数：2
    
17. ReDim crr(1 To UBound(arr) + UBound(brr), 1 To 2)
    
18. 
    
19. '循环数组arr,将arr的值赋值给crr的第一列，同时，建立字典，字典的关键字为数组的值，对应的项目给该值对应的位置
    
20. For i = 1 To UBound(arr)
    
21. crr(i, 1) = arr(i, 1)
    
22. d(arr(i, 1)) = i
    
23. Next
    
24. n = UBound(arr)
    
25. 
    
26. '循环数组brr,首先判断br的元素在字典中是否存在，如果存在，那么通过d(brr(j,1))找到这个元素在字典中所在的位置，然后把这个元素赋值给crr该元素所在位置的第二列
    
27. For j = 1 To UBound(brr)
    
28. If d.exists(brr(j, 1)) Then
    
29. crr(d(brr(j, 1)), 2) = brr(j, 1)
    
30. Else
    
31. 
    
32. '如果不存在，那么就写入到crr的n行2列，n的初始值是arr元素的数量，n+1,即第一个不在arr中的brr值写到crr的n+1行，之后每次出现都加一行，依次往下赋值
    
33. n = n + 1
    
34. crr(n, 2) = brr(j, 1)
    
35. End If
    
36. Next
    
37. 
    
38. '将crr的数据赋值到单元格区域
    
39. Sheets("两列数据对比").Range("D2").Resize(n, 2).Value = crr
    
40. End Sub

复制代码

AB两列数据对比.rar (20.75 KB, 下载次数: 4)

2024-10-4 11:19 上传

点击文件名下载附件

taller

hjd528 发表于 2024-10-4 11:21
网上抄的代码，不知是否符合要求。

结果和楼主要求不同，缺少在结果第一列中插入空行的相关代码