如何快速筛选出需要的数据

lshn2015

请教各位老师，如何快速筛选出需要的数据，需要把标成红色的数据找出来，由于数据比较多，现在的方法效率太低了，看看老师们有没什么好方法，提取后效果如图



补充内容 (2023-1-8 20:37):
后面回复里还有新的排版问题，希望老师能帮一下忙

624134745

筛选--颜色筛选

lshn2015

624134745 发表于 2022-12-17 15:10
筛选--颜色筛选

现在就是用的这个方法，但是一列一列弄也是效率很低，因为要把所有的红色数据分别放在两列

杨建营

做了一个代码的，只是只能读取一个工作表的数据，多个工作表要运行多次。新手练习，多多关照。

杨建营

请楼主参考，这是附件。

杨建营

请楼主参考。这次可以读取全部工作表了。有一点请注意，只能读取一次，如果需要再次读取，请先删除新建的工作表。有时间再去bug。

风中的我脸

练习一下筛选方法

1. Sub filterRed()
   
2.     Dim sht As Worksheet, rngFilter As Range
   
3.     Dim i As Long, lngCount As Long
   
4.     With Application
   
5.         .ScreenUpdating = False
   
6.         .DisplayAlerts = False
   
7.         .AskToUpdateLinks = False
   
8.         .Calculation = xlCalculationManual
   
9.     End With
   
10.    
    
11.     On Error Resume Next
    
12.     Sheets.Add(before:=Sheets(1)).Name = "结果"
    
13.     Sheets("结果").Cells.Clear
    
14.     If Err.Number Then
    
15.         ActiveSheet.Delete
    
16.         Err.Clear
    
17.     End If
    
18.    
    
19.     For Each sht In Worksheets
    
20.         With sht
    
21.             If .Name <> "结果" Then
    
22.                 With Sheets("结果")
    
23.                     .Range("a" & lngCount + 1) = sht.Name
    
24.                     lngCount = .Range("a1").CurrentRegion.Rows.Count
    
25.                 End With
    
26.                
    
27.                 For i = 2 To .Cells(1, Columns.Count).End(xlToLeft).Column Step 3
    
28.                     If .AutoFilterMode Then .AutoFilterMode = False
    
29.                     Set rngFilter = .Range(.Cells(2, i), .Cells(2, i + 1))
    
30.                     rngFilter.AutoFilter Field:=1, Criteria1:=RGB(255, 0 _
    
31.                         , 0), Operator:=xlFilterCellColor
    
32.                     .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy Sheets("结果").Range("a" & lngCount + 1)
    
33.                     
    
34.                     With Sheets("结果")
    
35.                         .Rows(lngCount + 1).Delete
    
36.                         lngCount = .Range("a1").CurrentRegion.Rows.Count
    
37.                     End With
    
38.                 Next
    
39.                 If .AutoFilterMode Then .AutoFilterMode = False
    
40.             End If
    
41.         End With
    
42.     Next
    
43. End Sub

复制代码

lshn2015

风中的我脸 发表于 2022-12-18 17:30
练习一下筛选方法

再次请教老师，如果是象现在这个表一样，只标红了条码或者没标红条码，也没有标红旁边的数值，能作出之前的效果吗？

风中的我脸

lshn2015 发表于 2022-12-21 19:30
再次请教老师，如果是象现在这个表一样，只标红了条码或者没标红条码，也没有标红旁边的数值，能作出之前 ...

可以的，你把上面的代码复制到新表里
记得保存为xlsm文件

lshn2015

风中的我脸 发表于 2022-12-21 19:34
可以的，你把上面的代码复制到新表里
记得保存为xlsm文件

好的，谢谢老师，我试了一下，有标红的是可以的，如果都没标红的话就是不行了，不过没什么太大问题，基本我们都会至少标红有问题的条码