求助如何自动根据关键字批量导出相关内容到其他工作表

ellick1988

上传模板内已有代码可以实现当类别内只有单个数据时，自动筛选复制，
请问如果如图类别以内单个单元格就存在多个关键字
能否根据类别内以“，”划分的关键字类别分别筛选出结果，然后按照不同类别分别建立对应名称的工作表并把结果拷贝过去？？？

清单表.zip (19.89 KB, 下载次数: 7)

2020-2-27 13:00 上传

点击文件名下载附件

闻启学

数量要分开吗  这个表 自己坑自己

ellick1988

闻启学 发表于 2020-2-27 13:20
数量要分开吗  这个表 自己坑自己

数量不用分开
其实我自己的表格是类似一个学生填报了一二三志愿，然后要把填报了那一个志愿的所有学生统计出来再分别发给所在志愿学校

dyp1610

1. Sub 入库()
   
2.     Dim i, n, arr, crr, brr(1 To 100, 1 To 11), sht As Worksheet
   
3.     arr = [a1].CurrentRegion
   
4.     For Each sht In Worksheets
   
5.         If sht.Name <> "不同供货商订货清单表" Then
   
6.             For i = 2 To UBound(arr)
   
7.                 crr = Split(arr(i, 2), ",")
   
8.                 For m = 0 To UBound(crr)
   
9.                     If crr(m) = sht.Name Then
   
10.                         n = n + 1
    
11.                         For j = 1 To 11
    
12.                             brr(n, j) = arr(i, j)
    
13.                             brr(n, 2) = sht.Name
    
14.                         Next
    
15.                     End If
    
16.                 Next
    
17.             Next
    
18.             sht.Range("a" & sht.[a65536].End(3).Row + 1).Resize(UBound(brr), 11) = brr
    
19.             n = 0
    
20.             Erase brr
    
21.             Erase crr
    
22.         End If
    
23.     Next
    
24.     MsgBox "搞定！", , ""
    
25. End Sub
    

复制代码

ellick1988

闻启学 发表于 2020-2-27 13:20
数量要分开吗  这个表 自己坑自己

上面发出来的是我在我们论坛上找到比较像我想要的那种效果的坛友的附件，再修改了下类别拿出来求助的

dyp1610

按你的思路改了一下，这种情况下需要手动添加工作表

grf1973

请看附件。

ellick1988

dyp1610 发表于 2020-2-27 13:35
按你的思路改了一下，这种情况下需要手动添加工作表

！！厉害！！非常感谢！！
请问如果我的类别列不在B列而在S列，请问该怎么改动？是吧“For i = 2”改成“For i = 19”吗？
另外可以帮忙设置成自动生成工作表吗？因为所有类别项有100多个手动建的话就悲剧了。。。

ellick1988

dyp1610 发表于 2020-2-27 13:35
按你的思路改了一下，这种情况下需要手动添加工作表

老师，因为我的项目有很多将近2千多条，请问代码里面的“brr(1 To 100, 1 To 11)”请教怎么修改合适，谢谢

dyp1610

ellick1988 发表于 2020-2-27 13:46
！！厉害！！非常感谢！！
请问如果我的类别列不在B列而在S列，请问该怎么改动？是吧“For i = 2”改成 ...

不是，for i=2 表示从数据表的第二行开始取数据，要改就改 arr(i,2),brr(i,2)中的2改成19