根据AB两列数据输出C列结果，通过C列结果匹配D列数据

gwjkkkkk

Sub TEST6()
    Dim arr, brr, i&, j&, R&, dic As Object
    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
    With Sheets(1).[A1].CurrentRegion.Resize(, 2)
       arr = Intersect(.Offset(), .Offset(1))
    End With
    ReDim brr(1 To UBound(arr) * UBound(arr, 2), 1 To 2)
    For i = 1 To UBound(arr)
       For j = 1 To UBound(arr, 2)
          If arr(i, j) <> "" Then
             R = R + 1: brr(R, 1) = arr(i, j)
          End If
       Next j
    Next i
    arr = Sheets(2).[A1].CurrentRegion
    For i = 2 To UBound(arr)
      dic(arr(i, 1)) = arr(i, 2)
    Next i
    For i = 1 To R
       brr(i, 2) = dic(brr(i, 1))
    Next i
    [F2].Resize(R, 2) = brr
    Set dic = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

代码审核中，请参考 附件。。。

倾听冷暖丿

gwjkkkkk 发表于 2022-12-7 11:12
代码审核中，请参考 附件。。。

非常感谢，

chzsh

试试可以吗？

倾听冷暖丿

gwjkkkkk 发表于 2022-12-7 11:12
Sub TEST6()
    Dim arr, brr, i&, j&, R&, dic As Object
    Application.ScreenUpdating = False

大神在请教一下，ABCD列统一往后面挪一列（BCDE），怎么改代码呢？

ykcbf1100

参与一下。

gwjkkkkk

倾听冷暖丿 发表于 2022-12-7 14:41
大神在请教一下，ABCD列统一往后面挪一列（BCDE），怎么改代码呢？

将文件发上来，模拟一下结果。。。

倾听冷暖丿

gwjkkkkk 发表于 2022-12-7 15:25
将文件发上来，模拟一下结果。。。

大神，请指教，已更新附件，就是在A列加了序号，输出结果需要和之前一样。

gwjkkkkk

倾听冷暖丿 发表于 2022-12-7 15:44
大神，请指教，已更新附件，就是在A列加了序号，输出结果需要和之前一样。

请楼主参考附件，如回复有请点击右下角评分 。。。

倾听冷暖丿

倾听冷暖丿 发表于 2022-12-7 15:44
大神，请指教，已更新附件，就是在A列加了序号，输出结果需要和之前一样。

大神，如果 B列空值，C列也是空值，D列能为空值吗？      现在的结果直接往上填充了。