[已解决]只能实现一列数据筛选，两列数据的共同数组不能实现，请帮忙看看

greview

谢谢

最佳答案

月排行榜 / 总排行榜

hfwufanhf2006

2020-1-17 19:15

你这个技术上我感觉没啥难度，就是一个体力活，要分10种情况分别写10段代码，因为你这10个分类表没有统一规则。看起来是有规则的，但每个表的规则各不相同，代码层面规则不好统一，分别各写一段可能还简单。
至于代码，先提供一个思路：
   1、把源数据写入数组；
   2、针对每个表的具体要求，对D、E、F的数据做条件判断，满足条件的就写入，不满足的就舍弃；

跳转到最佳答案楼层

hfwufanhf2006

你这个技术上我感觉没啥难度，就是一个体力活，要分10种情况分别写10段代码，因为你这10个分类表没有统一规则。看起来是有规则的，但每个表的规则各不相同，代码层面规则不好统一，分别各写一段可能还简单。
至于代码，先提供一个思路：
   1、把源数据写入数组；
   2、针对每个表的具体要求，对D、E、F的数据做条件判断，满足条件的就写入，不满足的就舍弃；

greview

hfwufanhf2006 发表于 2020-1-17 19:15
你这个技术上我感觉没啥难度，就是一个体力活，要分10种情况分别写10段代码，因为你这10个分类表没有统一规 ...

那帮忙给写一个吧，E列和F列 含共同数值的，E列和F列不含共同数值的，这两种情况不会判断

hfwufanhf2006

greview 发表于 2020-1-17 20:17
那帮忙给写一个吧，E列和F列 含共同数值的，E列和F列不含共同数值的，这两种情况不会判断

1、共同包含的：
    if (cells(i,"e")="化") or  (cells(i,"f")="化") then  
    'e列="化"或者f列=“化"，e和f列任意一列包含即可；
    ’参数i是因为要筛选所有内容，肯定是需要循环遍历的，i就是行参数
    '如果是使用数组装载源数据，则cells变换成对应数组;

2、都不包含：

    if (cells(i,"e")<>"化") and  (cells(i,"f")<>"化") then  
    'e列<>"化"并且f列也<>“化"
    '如果是使用数组装载源数据，则cells变换成对应数组;

greview

hfwufanhf2006 发表于 2020-1-17 23:40
1、共同包含的：
    if (cells(i,"e")="化") or  (cells(i,"f")="化") then  
    'e列="化"或者f列= ...

谢谢，原来思路固化了，以为能简化，按照您的思路能否给个成品，对比下学习学习
  With Worksheets("源")
    r = .Cells(.Rows.Count, 1).End(xlUp).Row
    arr = .Range("f1:g" & r)

这儿 怎么应用到    if (cells(i,"e")="化") or  (cells(i,"f")="化") then  
    'e列="化"或者f列= ...

hfwufanhf2006

greview 发表于 2020-1-18 10:09
谢谢，原来思路固化了，以为能简化，按照您的思路能否给个成品，对比下学习学习
  With Worksheets("源" ...

我写了三段，分别对历史、物理、化学做处理，后面的其他表，基本都是参照这个样子写就行了。
复制粘贴然后稍微修改下参数就行了：

Dim arr
arr = Range("a2:f" & [f10000].End(3).Row)      '把源数据写入数组

Rem 史的处理
If Worksheets("史").[f10000].End(3).Row >= 2 Then      '先清除，为了在修改源数据后能重复统计，这个条件不可少，否则在特定条件下标题会被清掉
   Worksheets("史").Range("a2:f" & Worksheets("史").[f10000].End(3).Row).ClearContents
End If
hs = 2      '写入的初始行数
For i = 1 To UBound(arr)
    If arr(i, 4) = "史" Then     ’d列包含“史"就写入
       Worksheets("史").Cells(hs, 1) = arr(i, 1)
       Worksheets("史").Cells(hs, 2) = arr(i, 2)
       Worksheets("史").Cells(hs, 3) = arr(i, 3)
       Worksheets("史").Cells(hs, 4) = arr(i, 4)
       Worksheets("史").Cells(hs, 5) = arr(i, 5)
       Worksheets("史").Cells(hs, 6) = arr(i, 6)
       hs = hs + 1
    End If
Next i

Rem 物的处理
If Worksheets("物").[f10000].End(3).Row >= 2 Then
   Worksheets("物").Range("a2:f" & Worksheets("物").[f10000].End(3).Row).ClearContents
End If
hs = 2
For i = 1 To UBound(arr)
    If arr(i, 4) = "物" Then
       Worksheets("物").Cells(hs, 1) = arr(i, 1)
       Worksheets("物").Cells(hs, 2) = arr(i, 2)
       Worksheets("物").Cells(hs, 3) = arr(i, 3)
       Worksheets("物").Cells(hs, 4) = arr(i, 4)
       Worksheets("物").Cells(hs, 5) = arr(i, 5)
       Worksheets("物").Cells(hs, 6) = arr(i, 6)
       hs = hs + 1
    End If
Next i

Rem 化的处理
If Worksheets("化").[f10000].End(3).Row >= 2 Then
   Worksheets("化").Range("a2:f" & Worksheets("化").[f10000].End(3).Row).ClearContents
End If
hs = 2
For i = 1 To UBound(arr)
    If (arr(i, 5) = "化") Or (arr(i, 6) = "化") Then
       Worksheets("化").Cells(hs, 1) = arr(i, 1)
       Worksheets("化").Cells(hs, 2) = arr(i, 2)
       Worksheets("化").Cells(hs, 3) = arr(i, 3)
       Worksheets("化").Cells(hs, 4) = arr(i, 4)
       Worksheets("化").Cells(hs, 5) = arr(i, 5)
       Worksheets("化").Cells(hs, 6) = arr(i, 6)
       hs = hs + 1
    End If
Next i

greview

hfwufanhf2006 发表于 2020-1-18 13:59
我写了三段，分别对历史、物理、化学做处理，后面的其他表，基本都是参照这个样子写就行了。
复制粘贴然 ...

谢谢