VBA如何按条件筛选数据（条件为空时自动忽略）

作者：绿色风分类：时间：2022-08-17 浏览：186

楼主芐雨	按条件筛选数据（条件为空时跳过）原文有四个筛选条件，筛选条件都有一个最大值与最小值。要求条件为空时，自动忽略条件。代码思路： 1.求出所有筛选条件用到的值以进行判断 2.条件为空时，把筛选条件的最大值设置为超大值，最小值设置为超小值。当数据判断时必定满足该条件，可视为自动忽略条件。代码如下： Sub 按条件筛选_芐雨() Dim arr, brr, i&, j% arr = Range("AJ2").CurrentRegion brr = [I16:J19] For i = 1 To UBound(brr) If Len(brr(i, 1)) = 0 Then brr(i, 1) = -(2 ^ 30) '如果为空，设一个超小值 If Len(brr(i, 2)) = 0 Then brr(i, 2) = 2 ^ 30 '如果为空，设一个超大值 Next xValue = [G17] ReDim crr(1 To UBound(arr), 1 To UBound(arr, 2)) For i = 2 To UBound(arr) '第一行是文本，从第二行开始 For j = 1 To UBound(arr, 2) If arr(i, j) Mod 2 = 1 Then xOdd = xOdd + 1 '奇数的个数 If arr(i, j) > xValue Then xVal = xVal + 1 '大于的个数 xSum = xSum + arr(i, j) '求和 xEndSum = xEndSum + (arr(i, j) Mod 10) '尾数和 Next If xOdd >= brr(1, 1) And xOdd <= brr(1, 2) _ And xVal >= brr(2, 1) And xVal <= brr(2, 2) _ And xSum >= brr(3, 1) And xSum <= brr(3, 2) _ And xEndSum >= brr(4, 1) And xEndSum <= brr(4, 2) Then x = x + 1 For y = 1 To UBound(arr, 2) '记入数组crr crr(x, y) = arr(i, y) Next End If xOdd = 0 '初始化 xVal = 0 xSum = 0 xEndSum = 0 Next Range("T2:Z" & Rows.Count).ClearContents '消除单元格内容 Range("T2").Resize(x, UBound(arr, 2)) = crr '输出结果 End Sub 按条件筛选数据（条件为空时自动忽略）_芐雨.zip
2楼亡者天下	不小心被秒了！
3楼老糊涂	学习

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，经与ExcelTip.Net站长Apolloh商议并征得其同意，现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，供有需要的人士查询使用，也慰缅曾经的论坛时代。所示各个帖子的原作者如对版权有异议，可与本人沟通提出，或于本站点留言，我们会尽快处理。在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一

评论列表

楼主芐雨	按条件筛选数据（条件为空时跳过）原文有四个筛选条件，筛选条件都有一个最大值与最小值。要求条件为空时，自动忽略条件。代码思路： 1.求出所有筛选条件用到的值以进行判断 2.条件为空时，把筛选条件的最大值设置为超大值，最小值设置为超小值。当数据判断时必定满足该条件，可视为自动忽略条件。代码如下： Sub 按条件筛选_芐雨() Dim arr, brr, i&, j% arr = Range("AJ2").CurrentRegion brr = [I16:J19] For i = 1 To UBound(brr) If Len(brr(i, 1)) = 0 Then brr(i, 1) = -(2 ^ 30) '如果为空，设一个超小值 If Len(brr(i, 2)) = 0 Then brr(i, 2) = 2 ^ 30 '如果为空，设一个超大值 Next xValue = [G17] ReDim crr(1 To UBound(arr), 1 To UBound(arr, 2)) For i = 2 To UBound(arr) '第一行是文本，从第二行开始 For j = 1 To UBound(arr, 2) If arr(i, j) Mod 2 = 1 Then xOdd = xOdd + 1 '奇数的个数 If arr(i, j) > xValue Then xVal = xVal + 1 '大于的个数 xSum = xSum + arr(i, j) '求和 xEndSum = xEndSum + (arr(i, j) Mod 10) '尾数和 Next If xOdd >= brr(1, 1) And xOdd <= brr(1, 2) _ And xVal >= brr(2, 1) And xVal <= brr(2, 2) _ And xSum >= brr(3, 1) And xSum <= brr(3, 2) _ And xEndSum >= brr(4, 1) And xEndSum <= brr(4, 2) Then x = x + 1 For y = 1 To UBound(arr, 2) '记入数组crr crr(x, y) = arr(i, y) Next End If xOdd = 0 '初始化 xVal = 0 xSum = 0 xEndSum = 0 Next Range("T2:Z" & Rows.Count).ClearContents '消除单元格内容 Range("T2").Resize(x, UBound(arr, 2)) = crr '输出结果 End Sub 按条件筛选数据（条件为空时自动忽略）_芐雨.zip
2楼亡者天下	不小心被秒了！
3楼老糊涂	学习