[已解决]指定单元格关键字筛选结果

楚雪飞扬

需求：
1.在F1输入关键这字，对A列进行筛选，只显示符合条件的
2.在F2输入关键这字，对B列进行筛选，只显示符合条的
3.在F3得出符合条件的行数!

最佳答案

月排行榜 / 总排行榜

zglibk

2022-1-5 20:56

贴上代码，与附件中代码相比，只是把没有用到的变量给删了

1. Sub 按文件名()
   
2.     Dim r&, Arr, Brr, fn$, n%, x%
   
3.    
   
4.     fn = Sheet1.Range("F1")
   
5.     If Len(fn) = 0 Then Exit Sub
   
6.     With Sheet2
   
7.         r = .Cells(Rows.Count, 1).End(xlUp).Row
   
8.         Arr = .Range("a2:c" & r)
   
9.     End With
   
10. 
    
11.     ReDim Brr(1 To 3, 1 To 1)
    
12.     x = 0
    
13.     For i = 1 To UBound(Arr)
    
14.         If InStr(Arr(i, 1), fn) > 0 Then
    
15.             x = x + 1
    
16.             n = n + 1  ' 符合条件时的记录数（记数器）
    
17.             ReDim Preserve Brr(1 To 3, 1 To x)
    
18.             For j = 1 To 3
    
19.                 Brr(j, x) = Arr(i, j)
    
20.             Next
    
21.         End If
    
22.     Next
    
23.     With Sheet1
    
24.         .Range("a2:c" & .Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
    
25.         .Range("a2").Resize(UBound(Brr, 2), UBound(Brr, 1)) = Application.WorksheetFunction.Transpose(Brr)
    
26.         .Range("F3") = n
    
27.     End With
    
28. End Sub
    

复制代码

跳转到最佳答案楼层

zjdh

71.5478515625KB怎么会符合70KB?

zjdh

按这误差
68.5185546875KB 更加符合 70KB

sam-wang

請測試看看，條件如下，謝謝


1.在F1输入关键这字，对A列进行筛选，只显示符合条件的 >> 包含F1字
2.在F2输入关键这字，对B列进行筛选，只显示符合条的 >> 小於F2數值

zglibk

上个效果图，如楼主有需要再上附件

楚雪飞扬

zglibk 发表于 2022-1-5 15:19
上个效果图，如楼主有需要再上附件

能上传个附件吗

zglibk

请测试附件
获取文件属性_220105_Demo 测试.rar (17.91 KB, 下载次数: 7)

2022-1-5 20:43 上传

点击文件名下载附件

zglibk

将你原来的按钮中的代码稍微做了修改：将获取到的文件信息保存到了 Sheet2 中，Sheet1 专门用来显示查询结果。
另外，文件尺寸查询没写，可依葫芦画瓢再写一个 sub 给单元格触发时调用

zglibk

贴上代码，与附件中代码相比，只是把没有用到的变量给删了

1. Sub 按文件名()
   
2.     Dim r&, Arr, Brr, fn$, n%, x%
   
3.    
   
4.     fn = Sheet1.Range("F1")
   
5.     If Len(fn) = 0 Then Exit Sub
   
6.     With Sheet2
   
7.         r = .Cells(Rows.Count, 1).End(xlUp).Row
   
8.         Arr = .Range("a2:c" & r)
   
9.     End With
   
10. 
    
11.     ReDim Brr(1 To 3, 1 To 1)
    
12.     x = 0
    
13.     For i = 1 To UBound(Arr)
    
14.         If InStr(Arr(i, 1), fn) > 0 Then
    
15.             x = x + 1
    
16.             n = n + 1  ' 符合条件时的记录数（记数器）
    
17.             ReDim Preserve Brr(1 To 3, 1 To x)
    
18.             For j = 1 To 3
    
19.                 Brr(j, x) = Arr(i, j)
    
20.             Next
    
21.         End If
    
22.     Next
    
23.     With Sheet1
    
24.         .Range("a2:c" & .Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
    
25.         .Range("a2").Resize(UBound(Brr, 2), UBound(Brr, 1)) = Application.WorksheetFunction.Transpose(Brr)
    
26.         .Range("F3") = n
    
27.     End With
    
28. End Sub
    

复制代码

楚雪飞扬

zglibk 发表于 2022-1-5 20:56
贴上代码，与附件中代码相比，只是把没有用到的变量给删了

感谢帮忙，一会有空了在测试，！