假设表1表2中的数据都存放在A/B/C三列,结果输出到表3的A/B/C列。
在宏编辑器的ThisWorkbook中输入以下代码,运行:
'设置数据下标从1开始
Option Base 1
Sub combine()
Dim rmax1%, rmax2%, k%, m%, n%
Dim array1(), array2(), array3()
Application.ScreenUpdating = False
'清除表3原有的数据及颜色填充
Sheet3.Range("A:C").ClearFormats
Sheet3.Range("A:C").ClearContents
'读取表1、表2的最大行数
rmax1 = Sheet1.Range("A65536").End(xlUp).Row
rmax2 = Sheet2.Range("A65536").End(xlUp).Row
'表1、表2的内容分别赋值给两个二维数组
array1 = Sheet1.Range("A1").Resize(rmax1, 3)
array2 = Sheet2.Range("A1").Resize(rmax2, 3)
'用于输出结果的数组,行数将是数组1行数的两倍
ReDim Preserve array3(rmax1 * 2, 3)
'比对数据,输出结果
For m = 1 To UBound(array1, 1)
array3(m * 2 - 1, 1) = array1(m, 1)
array3(m * 2 - 1, 2) = array1(m, 2)
array3(m * 2 - 1, 3) = array1(m, 3)
Sheet3.Range("A" & m * 2 - 1 & ":C" & m * 2 - 1).Interior.Color = 255
For n = 1 To UBound(array2, 1)
If array2(n, 2) = array1(m, 2) Then
array3(m * 2, 1) = array2(n, 1)
array3(m * 2, 2) = array2(n, 2)
array3(m * 2, 3) = array2(n, 3)
Sheet3.Range("A" & m * 2 & ":C" & m * 2).Interior.Color = 65535
Exit For
End If
If n = UBound(array2, 1) Then
array3(m * 2, 1) = ""
array3(m * 2, 2) = ""
array3(m * 2, 3) = ""
End If
Next
Next
'将数组3中的数据输出到表3中
Sheet3.Range("A1").Resize(rmax1 * 2, 3) = array3
Application.ScreenUpdating = True
End Sub