Excel精英培训网

 找回密码
 注册

QQ登录

只需一步,快速开始

数据透视表40+个常用小技巧,让你一次学会!
查看: 130|回复: 2

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

[复制链接]
发表于 2022-6-15 14:07 | 显示全部楼层 |阅读模式
根据表2,G列数据匹配表1,E列数据
将匹配后的数据整份复制到SHEET4

最佳答案
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

结单自动分析.zip

995.75 KB, 下载次数: 15

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
 楼主| 发表于 2022-6-15 14:52 | 显示全部楼层
根据表2 G列单元格数据,提取表1,整份数据到表4
回复

使用道具 举报

发表于 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

评分

参与人数 1学分 +2 收起 理由
楚雪飞扬 + 2 学习了

查看全部评分

回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2022-8-15 12:09 , Processed in 0.216514 second(s), 14 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表