请问该如何在一页面中输入关键词，使VBA在另一页面将相同关键词数据整行复制

haven2010

各位大大好，小妹是VBA新手，目前还只能大概看懂VBA并稍微修改功能

但现阶段爬文都没找到相关功能，只好上来求助各位大大

顺便学习相关方法

目前需要在一个《关键词》页面输入需要的关键词

然后从《清单》页面抓取与关键词条目相同之数据，并按顺序整行复制到《主要关键词》

STEP1

STEP2

STEP3

拜托各位大大帮忙了QQ

[url=]问题.zip[/url]

hfwufanhf2006

结构上就是双循环走一遍就行了，比较简单；文件最后添加了一个表，在这个添加的表中执行，你原来的表也保留着；
第一行需要选择筛选的类型，如果不选，代码不会往下执行会自动退出；
结果好像与你的模板有点出入，我也不知道哪里错了，你自己核对下，如果发现有问题，你具体指出来，我再修改；

haven2010

非常感谢大大帮助，因为看起来是同时比对
所以并非按照关键词的顺序，而是按照清单顺序
并且同样出现过的数据也被当作同一格，所以可能每一个关键词都需要重复循环走一遍才能達成

不过已经非常感谢大大了QQ

haven2010

看起来是因为参照顺序是以列表顺序，并非以关键词顺序比对
如此看来可能比对时要按照关键词的顺序，每一格都重新循环走一遍
目前看到的原因是以同时比对，并以清单第一个出现的先贴上，才会有这样的差异
不过还是感谢大大帮助，非常感谢您!!!QQ

haven2010

hfwufanhf2006 发表于 2020-7-3 15:05
结构上就是双循环走一遍就行了，比较简单；文件最后添加了一个表，在这个添加的表中执行，你原来的表也保留 ...

按结果来看，应该是因为同时比对，所以筛选的内容变成列表顺序，并且重复的关键词也都没有按顺序重复贴上
但因为目标是按照关键词顺序来贴上，所以可能要改成按关键词一项一项筛选复制，比较麻烦
不过已经很感谢大大了QQ

haven2010

Dim arr
arr = Worksheets("关键词").Range("a2:b" & Worksheets("关键词").[a10000].End(3).Row)
For i = 2 To Worksheets("清单").[a65000].End(3).Row
    bz = False
    If s = "主要关键词" Then
       s1 = Worksheets("清单").Cells(i, 1)
       For k = 1 To UBound(arr)
           If arr(k, 1) = s1 Then
              bz = True
              Exit For
           End If
       Next k
    Else

应该是这一部分，因为是抓A列最后一格的最底列数导致换成次要关键词的时候，抓不到最后一个关键词
(次要关键词和主要关键词不一定一样长)
然后底下筛选的时候，可能需要一格一格筛选…