Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2500|回复: 13

[已解决]求助一个数据筛选的问题!

[复制链接]
发表于 2012-12-22 14:51 | 显示全部楼层 |阅读模式
表中数据已按条件引用出来了,总共有五个数据栏,如果A1下拉选择二班,数据1的筛选是对的,都是显示二班的数据,但数据2、3、4、5栏的就不对了,如何能将一个班五个数据栏都筛选出来?普通的筛选解决不了这个问题,用VBA可以解决吗?
最佳答案
2012-12-24 22:16
ntyyz 发表于 2012-12-24 21:37
还要再请教一下,如何在筛选的时候将数据中空白的单元格去掉,只显示有数值的单元格?

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$C$1" Then
        On Error Resume Next
        Dim BRR(1 To 500, 1 To 4)
        Sheets("自动筛选").Range("A3:T536").ClearContents
        Arr = Sheets("数据").Range("A2:H" & Sheets("数据").Range("A65536").End(3).Row)
        For I = 1 To 5
            For J = 1 To UBound(Arr)
                If Target.Value = "全部" Then
                    If Arr(J, I + 3) > 5.7 Or Arr(J, I + 3) < 5.2 And Arr(J, I + 3) <> "" Then
                        N = N + 1
                        For T = 1 To 3
                            BRR(N, T) = Arr(J, T)
                        Next
                        BRR(N, 4) = Arr(J, I + 3)
                    End If
                Else
                    If Arr(J, 1) = Target.Value And (Arr(J, I + 3) > 5.7 Or Arr(J, I + 3) < 5.2) And Arr(J, I + 3) <> "" Then
                        N = N + 1
                        For T = 1 To 3
                            BRR(N, T) = Arr(J, T)
                        Next
                        BRR(N, 4) = Arr(J, I + 3)
                    End If
                End If
            Next
            Range("A3").Offset(0, (I - 1) * 4).Resize(N, 4) = BRR
            Erase BRR
            N = 0
        Next
    End If
End Sub

数据筛选.rar

26.35 KB, 下载次数: 11

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2012-12-22 15:54 | 显示全部楼层
数据筛选.rar (36.02 KB, 下载次数: 16)
回复

使用道具 举报

 楼主| 发表于 2012-12-23 13:09 | 显示全部楼层
zjdh 发表于 2012-12-22 15:54

谢谢,结果就是我想要的,还有两个问题:1、<5.2没有被筛选出来。2、可以选择显示全部班组吗?帮我改一下。
回复

使用道具 举报

发表于 2012-12-23 13:46 | 显示全部楼层
修改一下格式,可以使用高级筛选,高级筛选,支持 多项查询,条件可随意添加
下图是效果图
222.gif

下面是代码:

  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2.   With Target
  3.     If .Count > 1 Then Exit Sub
  4.     If .Row <> 2 Then Exit Sub
  5.     If .Column > 20 Then Exit Sub
  6.     Dim Dz1 As String, Dz2 As String
  7.     Select Case .Column
  8.       Case Is < 5
  9.         Dz1 = "A1:D2"
  10.         Dz2 = "A3: D3"
  11.       Case Is < 9
  12.         Dz1 = "E1:H2"
  13.         Dz2 = "E3:H3"
  14.       Case Is < 13
  15.         Dz1 = "I1:L2"
  16.         Dz2 = "I3:L3"
  17.       Case Is < 17
  18.         Dz1 = "M1:P2"
  19.         Dz2 = "M3:P3"
  20.       Case Else
  21.        Dz1 = "Q1:S2"
  22.        Dz2 = "Q3:S3"
  23.     End Select
  24.     Sheet2.Range("A:H").AdvancedFilter 2, Range(Dz1), Range(Dz2)
  25.   End With
  26. End Sub
复制代码
说明:
高级筛选,是根据 数据源的表头,做为字段名,添加上筛选条件  ">,<,=,>=,<= ,= " 同时支持 通配符 ," ?,* "

下面是附件
数据筛选.zip (47.43 KB, 下载次数: 9)
回复

使用道具 举报

发表于 2012-12-23 13:53 | 显示全部楼层
对于你的问题使用高级筛选需要注意的是

筛选条件可以随意设置,同时显示的内容也可以随意设置

比如,我们将条件设置筛选数据2,显示的结果是数据1

则修改 A:D 列中第一行的 数据1 为 数据2
然后操作一下单元格,这时候是按照 数据2 的条件来筛选的,显示的只是数据1

当然,你也可以自己重新设置要显示的字段, 只需要修改第三行的 字段名就可以随意显示你想要看的内容了
  
回复

使用道具 举报

发表于 2012-12-23 14:50 | 显示全部楼层
ntyyz 发表于 2012-12-23 13:09
谢谢,结果就是我想要的,还有两个问题:1、

数据筛选2.rar (37.24 KB, 下载次数: 3)
回复

使用道具 举报

发表于 2012-12-23 17:50 | 显示全部楼层
其实高级筛选可以直接一次生成多个区域的数据,

重新修改一下表头,代码变得非常简单了!!

QQ截图20121223174919.jpg


代码如下:

  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2.   With Target
  3.     If .Count > 1 Then Exit Sub
  4.     If .Row <> 2 Then Exit Sub
  5.     If .Column > 20 Then Exit Sub
  6.     Sheet2.Range("A:H").AdvancedFilter 2, Range("A1:H2"), Range("A3:T3")
  7.   End With
  8. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2012-12-24 21:37 | 显示全部楼层
zjdh 发表于 2012-12-22 15:54

还要再请教一下,如何在筛选的时候将数据中空白的单元格去掉,只显示有数值的单元格?
回复

使用道具 举报

 楼主| 发表于 2012-12-24 22:05 | 显示全部楼层
无聊的疯子 发表于 2012-12-23 17:50
其实高级筛选可以直接一次生成多个区域的数据,

重新修改一下表头,代码变得非常简单了!!

谢谢您的解答,试了下可以用,但条件不能同时满足>多少和<多少.
回复

使用道具 举报

发表于 2012-12-24 22:16 | 显示全部楼层    本楼为最佳答案   
ntyyz 发表于 2012-12-24 21:37
还要再请教一下,如何在筛选的时候将数据中空白的单元格去掉,只显示有数值的单元格?

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$C$1" Then
        On Error Resume Next
        Dim BRR(1 To 500, 1 To 4)
        Sheets("自动筛选").Range("A3:T536").ClearContents
        Arr = Sheets("数据").Range("A2:H" & Sheets("数据").Range("A65536").End(3).Row)
        For I = 1 To 5
            For J = 1 To UBound(Arr)
                If Target.Value = "全部" Then
                    If Arr(J, I + 3) > 5.7 Or Arr(J, I + 3) < 5.2 And Arr(J, I + 3) <> "" Then
                        N = N + 1
                        For T = 1 To 3
                            BRR(N, T) = Arr(J, T)
                        Next
                        BRR(N, 4) = Arr(J, I + 3)
                    End If
                Else
                    If Arr(J, 1) = Target.Value And (Arr(J, I + 3) > 5.7 Or Arr(J, I + 3) < 5.2) And Arr(J, I + 3) <> "" Then
                        N = N + 1
                        For T = 1 To 3
                            BRR(N, T) = Arr(J, T)
                        Next
                        BRR(N, 4) = Arr(J, I + 3)
                    End If
                End If
            Next
            Range("A3").Offset(0, (I - 1) * 4).Resize(N, 4) = BRR
            Erase BRR
            N = 0
        Next
    End If
End Sub

评分

参与人数 1 +1 收起 理由
ntyyz + 1 很给力!

查看全部评分

回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 02:01 , Processed in 0.393711 second(s), 15 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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