[已解决]关键字筛选复制明细

楚雪飞扬

根据表2,G列数据匹配表1，E列数据
将匹配后的数据整份复制到SHEET4

最佳答案

月排行榜 / 总排行榜

sam-wang

2022-6-15 15:18

是這樣嗎? 請測試看看，謝謝

Sub test()
Dim Arr, xD, T$, i&, j%, n&
Set xD = CreateObject("Scripting.Dictionary")
With Sheet2
    Arr = .[g1].CurrentRegion
    For i = 2 To UBound(Arr): T = Arr(i, 1): xD(T) = 1: Next
End With
With Sheet1
    Arr = .[a2].CurrentRegion
    For i = 2 To UBound(Arr)
        T = Arr(i, 5)
        If xD(T) = 1 Then
            n = n + 1
            For j = 1 To UBound(Arr, 2): Arr(n, j) = Arr(i, j): Next
        End If
    Next
End With
If n > 1 Then
    With Sheets("Sheet4")
        .[a1].Resize(n, UBound(Arr, 2)) = Arr
    End With
End If
End Sub

跳转到最佳答案楼层

楚雪飞扬

根据表2 G列单元格数据，提取表1,整份数据到表4

sam-wang

是這樣嗎? 請測試看看，謝謝

Sub test()
Dim Arr, xD, T$, i&, j%, n&
Set xD = CreateObject("Scripting.Dictionary")
With Sheet2
    Arr = .[g1].CurrentRegion
    For i = 2 To UBound(Arr): T = Arr(i, 1): xD(T) = 1: Next
End With
With Sheet1
    Arr = .[a2].CurrentRegion
    For i = 2 To UBound(Arr)
        T = Arr(i, 5)
        If xD(T) = 1 Then
            n = n + 1
            For j = 1 To UBound(Arr, 2): Arr(n, j) = Arr(i, j): Next
        End If
    Next
End With
If n > 1 Then
    With Sheets("Sheet4")
        .[a1].Resize(n, UBound(Arr, 2)) = Arr
    End With
End If
End Sub