精华内容
下载资源
问答
  • vba关于取消自动筛选:

    千次阅读 2020-05-20 21:08:27
    关于取消自动筛选: If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData 从蓝桥玄霜版主那看到了,先判断是否做了筛先. ================= 取消自动筛选: Sheets("sheet1").AutoFilterMode = False '注意这里...

    关于取消自动筛选:    
    If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
    从蓝桥玄霜版主那看到了,先判断是否做了筛先.
    =================
    取消自动筛选:
    Sheets("sheet1").AutoFilterMode = False '注意这里对象是sheet, 不需要sheet中的具体区域,比如[a1:c1]之类
    '关于Autofiltermode与Filtermode的区别, 前是是已经使用了筛选状态. 首行中已经出现筛选行.
    Filtermode: 如果是被筛选过的,那么Filtermode就是True. 
    Autofiltermode:不管有没有被筛选过, Autofiltermode=True
    取消高级筛选:
    If Sheets("sheet1").FilterMode = True Then Sheets("sheet1").ShowAllData
    =============
    简单的宏眼中的取消与加入自动筛选
        Rows("2:2").Select
        Selection.AutoFilter
    或Sheet1.[a1:m1].AutoFilter '注意, 这里前方的对象需要是区域range,而不是sheet,和Autofiltermode与Filtermode不一样
    =============
    如果存在自动筛选状态的情况下,以下不会把被筛选而隐藏的那些行给删除,所以需要先取消筛选(filtermode+showalldata)
    my.Rows("3:1000000") = ""

    展开全文
  • 细说自动筛选和高级筛选通过VBA快速文本筛选

    细说自动筛选和高级筛选通过VBA快速文本筛选
    排序中的自定义排序的引用序列如何能够用VBA来写活,指定按某列顺序来排序来

    Attribute VB_Name = "find_cell"
    Option Explicit
    
    Sub select1()
    Attribute select1.VB_ProcData.VB_Invoke_Func = " \n14"
    '
    ' select1 宏
    '
    
    '
        Range("A1").Select
        Range(Selection, Selection.End(xlToRight)).Select
    End Sub
    Sub filldown()
    Attribute filldown.VB_ProcData.VB_Invoke_Func = " \n14"
    '
    ' filldown 宏
    '
    
    '
        Range("A1:A8").Select
        Selection.filldown
        
        Selection.copy
        Range("D11").Select
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
    End Sub
    Sub copy()
    Attribute copy.VB_ProcData.VB_Invoke_Func = " \n14"
    '
    ' copy 宏
    '
    
    '
        Range("E2").Select
        Selection.copy
        Range("E13").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("F13").Select
        ActiveSheet.Paste
        Range("G13").Select
        Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        Range("H13").Select
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
        Range("I13").Select
        Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        Range("J13").Select
        ActiveSheet.Paste Link:=True
        Range("K13").Select
        Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
            , SkipBlanks:=False, Transpose:=False
        Range("L13").Select
        Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        Range("M13").Select
        ActiveSheet.Paste
        Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        Range("N13").Select
        Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
            , SkipBlanks:=False, Transpose:=False
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("O13").Select
        ActiveSheet.Pictures.Paste.Select
        ActiveSheet.Shapes.Range(Array("Picture 1")).Select
        Range("P13").Select
        ActiveSheet.Pictures.Paste(Link:=True).Select
        ActiveSheet.Shapes.Range(Array("Picture 2")).Select
    End Sub
    Sub delwq()
    Attribute delwq.VB_ProcData.VB_Invoke_Func = " \n14"
    '
    ' delwq 宏
    '
    
    '
        ActiveSheet.Shapes.Range(Array("Picture 1")).Select
        Selection.Delete
        ActiveSheet.Shapes.Range(Array("Picture 2")).Select
        Selection.Cut
        Range("K13").Select
        Selection.Delete Shift:=xlToLeft
        Range("L13").Select
        Selection.Delete Shift:=xlUp
        Range("M13").Select
        Selection.EntireRow.Delete
        Selection.EntireColumn.Delete
        Selection.ClearContents
        Range("M13").AddComment
        Range("M13").Comment.Visible = False
        Range("M13").Comment.text text:="123"
        Range("M13").Select
        Selection.NumberFormatLocal = "0_ "
        Selection.NumberFormatLocal = "yyyy/m/d h:mm;@"
        Selection.NumberFormatLocal = "@"
        Range("N13").Select
        ActiveCell.FormulaR1C1 = "3/24/2019 12:45"
        Range("N14").Select
        Columns("N:N").ColumnWidth = 15.33
        Range("N14").Select
        ActiveCell.FormulaR1C1 = "123456"
        Range("N14").Select
        With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        Range("N13").Select
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent1
            .TintAndShade = 0.599993896298105
            .PatternTintAndShade = 0
        End With
        With Selection.Font
            .Color = -16776961
            .TintAndShade = 0
        End With
        Range("N14").Select
    End Sub
    
    Sub usedrow()
    Dim re
    On Error Resume Next
    
    Range("B3", Cells(ActiveSheet.UsedRange.Rows.Count, 2)).SpecialCells (xlCellTypeBlanks)
    '不用管,对齐问题,要想接收对象,必须用set ,如果函数的返回是对象可以直接写对象的操作,也可以保存对象的引用,再使用对象方法
    'MSCell("工号").Select
    '要想变量接收对象要写成下面的形式
    Set re = MSCell("工号")
    re.Select
    
    
    End Sub
    Sub get_area()
    Dim re, findc, i, row_, col_
    For Each i In Worksheets
        Debug.Print i.Name
        i.Select
        row_ = ActiveSheet.UsedRange.Rows.Count
        col_ = ActiveSheet.UsedRange.Columns.Count
        Set re = MSCell("工号", i.Name)
        re.Select
        findc = Empty
        On Error Resume Next
        Debug.Print ActiveSheet.UsedRange.Rows.Count: Set findc = Range(re, Cells(ActiveSheet.UsedRange.Rows.Count, re.Column)): Debug.Print findc.Address: findc.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        
    Next
    
    
    End Sub
    Function MSCell(value As String, shname As String)
    
        Dim result
        Sheets(shname).Select
        Set result = Cells.Find(What:=value, After:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, MatchByte:=False, SearchFormat:=False)
        If result.Count = 1 Then
            Set MSCell = result
            result.Select
        Else:
            Debug.Print result.Count
        End If
    End Function
    
    
    Attribute VB_Name = "copyfilterfiled1"
    Option Explicit
    Dim exists_f, wk, sh
    
    
    Sub sheet_s(sheet)
    exists_f = False
    
    For Each wk In Workbooks
        For Each sh In wk.Worksheets
            If sh.Name = sheet Then
                exists_f = True
                wk.Activate
                sh.Select
            End If
            
        Next
        
    Next
    If exists_f = True Then
     Debug.Print "sheet exists"
    Else
     Debug.Print "Error not exists"
    End If
    
    
    
    End Sub
    
    
    Sub 宏1()
    Attribute 宏1.VB_ProcData.VB_Invoke_Func = " \n14"
    '
    ' 宏1 宏
    '
    
    '
        sheet_s ("new")
        On Error Resume Next
            Sheets("new").Select
        If Err Then
        Debug.Print "sheet no exists"
        Else
        Sheets("new").UsedRange.Select: Debug.Print Selection.Name: Selection.AutoFilter: Selection.Delete
        End If
        
        'Sheets("new").Select
        Dim result, re, myrange
        
        Sheets("sheet3").Select
        Set result = Cells.Find(What:="一级渠道名称", After:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, MatchByte:=False, SearchFormat:=False)
        If result.Count = 1 Then
            result.Select
        Else:
            Debug.Print result.Count
        End If
        Range(result, result.End(xlToRight)).Select
        
        Selection.AutoFilter
        ActiveSheet.Range("$A$1:$R$78").AutoFilter Field:=8, Criteria1:=Array( _
            "福安小区", "古南小区", "剑河家苑"), Operator:=xlFilterValues
        ActiveSheet.UsedRange.Select
        'result.UsedRange.Select
        
        
        
        
        Selection.copy
        On Error Resume Next
            Sheets("new").Select
        If Err Then Sheets.Add().Name = "new"
        Sheets("new").Select
    
        
        Range("c3").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
        ActiveSheet.UsedRange.Select
        Debug.Print ActiveSheet.UsedRange.Address
        
        Set re = ActiveSheet.UsedRange.Find(What:="用户手机", After:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, MatchByte:=False, SearchFormat:=False)
            
        re.EntireRow.Select
        Selection.EntireRow.NumberFormatLocal = "0_ "
            
        Set myrange = Application.InputBox(prompt:="select a cells,is date time", Type:=8)
        myrange.Select
        Selection.EntireRow.NumberFormatLocal = "yyyy/m/d h:mm;@"
        With Selection.Font
            .Color = -16776961
            .TintAndShade = 0
        End With
        myrange.Rows.Item("2:3").Select
        Selection.EntireRow.NumberFormatLocal = "yyyy/m/d h:mm;@"
        'ActiveSheet.Paste
        
        Range("O3").Select
        Sheets("sheet3").Select
        Selection.AutoFilter
    End Sub
    Sub filter1()
    Attribute filter1.VB_ProcData.VB_Invoke_Func = " \n14"
    '
    ' filter1 宏
    '
    
    '
        Selection.AutoFilter
        ActiveSheet.Range("$A$1:$R$78").AutoFilter Field:=8, Criteria1:=Array( _
            "福安小区", "古南小区", "剑河家苑"), Operator:=xlFilterValues
    End Sub
    
    
    Attribute VB_Name = "删除空行"
    Option Explicit
    
    Sub text()
        'Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete '找A列所有空单元格,然后删除空单元格所在行
        'Range("A1:D12").SpecialCells(xlCellTypeBlanks).Activate
        Range("A1:D12").SpecialCells(xlCellTypeLastCell).Activate
        Debug.Print Range("A1:D12").SpecialCells(xlCellTypeBlanks).Count
        Debug.Print Range("A1:A13").SpecialCells(xlCellTypeBlanks).Count
        
        
    End Sub
    Sub 删除空行()
    
    Dim rng As Range, ads As String, ad As String
    
    
    For Each rng In [a1:a14]
    
      If rng = "" Then ad = ad & rng.Address & ","
    
    Next
    
    ads = Left(ad, Len(ad) - 1)
    Debug.Print ads
    Debug.Print Range(ads).Address
    
    
    
    
    'Range(ads).EntireRow.Delete
    
    End Sub
    Sub xx()
        Range("A1:L6").Columns.AutoFit
    End Sub
    Sub arr()
    Dim MyArr(), MyRng As Range, NewRng As Range, a
    Debug.Print ActiveSheet.Name
    
    
    '''初始化
    Set MyRng = Range("A1:B3")
    MyArr = MyRng
    '''处理
    '''在
    '区域输出
    Debug.Print MyRng.Address
    Debug.Print MyRng.value
    For Each a In MyArr
    Debug.Print a
    Next
    
    
    
    End Sub
    
    
    
    Attribute VB_Name = "图表"
    Option Explicit
    
    Sub 宏1()
    Attribute 宏1.VB_ProcData.VB_Invoke_Func = " \n14"
    '
    ' 宏1 宏
    '
    
    '
        Columns("E:F").Select
    End Sub
    Sub 宏2()
    Attribute 宏2.VB_ProcData.VB_Invoke_Func = " \n14"
    '
    ' 宏2 宏
    '
    
    '
        Range("B2:C8").Select
        ActiveSheet.Shapes.AddChart2(227, xlLine).Select
        ActiveChart.SetSourceData Source:=Range("工作簿1!$B$2:$C$8")
        ActiveSheet.Shapes("图表 1").IncrementLeft -115.8
        ActiveSheet.Shapes("图表 1").IncrementTop 48
        ActiveChart.PlotArea.Select
        Application.CutCopyMode = False
        Application.CutCopyMode = False
        Application.CutCopyMode = False
        Application.CutCopyMode = False
        ActiveChart.FullSeriesCollection(1).Delete
        ActiveChart.SeriesCollection.NewSeries
        ActiveChart.FullSeriesCollection(1).Name = "=工作簿1!$B$4:$C$4"
        ActiveChart.FullSeriesCollection(1).Values = "=工作簿1!$H$4:$K$4"
        ActiveChart.FullSeriesCollection(1).XValues = "=工作簿1!$H$1:$K$1"
        ActiveChart.ChartArea.Select
        ActiveSheet.Shapes("图表 1").ScaleWidth 1.0741666667, msoFalse, _
            msoScaleFromTopLeft
        ActiveSheet.Shapes("图表 1").ScaleHeight 1.0583333333, msoFalse, _
            msoScaleFromBottomRight
        ActiveSheet.Shapes("图表 1").IncrementLeft 15.6
        ActiveSheet.Shapes("图表 1").IncrementTop 49.8
    End Sub
    Sub 宏3()
    Attribute 宏3.VB_ProcData.VB_Invoke_Func = " \n14"
    '
    ' 宏3 宏
    '
    
    '
        Range("G2").Select
        Selection.copy
        Range("H6:K6").Select
        Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        Range("K8").Select
    End Sub
    
    
    展开全文
  • 在已经输入的数据中,找到复制想要的数据,然后粘贴到指定的地方,是再自然不过的操作了。或者从工作表的一个单元格区域复制到同一工作表中另外的单元格区域,或者从工作表的一个单元格区域复制到另一工作表中的...

    学习Excel技术,关注微信公众号:

    excelperfect

    在Excel工作表中,复制粘贴是最常用的操作之一。在已经输入的数据中,找到并复制想要的数据,然后粘贴到指定的地方,是再自然不过的操作了。或者从工作表的一个单元格区域复制到同一工作表中另外的单元格区域,或者从工作表的一个单元格区域复制到另一工作表中的单元格区域,甚至从工作表的一个单元格区域复制到不同工作簿中的工作表单元格区域。那么,如何使用VBA代码来实现复制粘贴操作呢?本文将介绍常用的一些代码。

    直接赋值

    如下图1所示,使用代码:

    Range("D1:E2").Value= Range("A1:B2").Value

    将单元格区域A1:B2中的值直接复制到单元格D1:E2中。

    322a39b00d2ced2653e01818ab42b769.png

    图1

    使用Copy方法

    也可以使用Copy方法,将单元格区域A1:B2中的值复制到以单元格D1开头的单元格区域中:

    Range("A1:B2").CopyRange("D1")

    e3ea07eeb023ed02ab7879a7c59a0c56.png

    图2

    使用数组

    如下图3所示,将工作表Sheet4的列A中内容为“完美Excel”的行复制到工作表Sheet5中。

    2eb0d4c3b9a05ed7bfc0e6c8a7ccee7b.png

    图3

    可以使用下面的代码:

    Sub CopyDataByArray()

        Dim arr As Variant

        Dim i As Long

        Dim j As Long

        Dim row As Long

        row = 1

        arr =Sheet4.Range("A1").CurrentRegion.Value

        For i = LBound(arr) To UBound(arr)

            If arr(i, 1) = "完美Excel" Then

                For j = LBound(arr, 2) ToUBound(arr, 2)

                    Sheet5.Cells(row, j).Value =arr(i, j)

                Next j

                row = row + 1

            End If

        Next i

    End Sub

    代码中,将工作表Sheet4中的数据存储到数组中。然后,判断数组中第1维的值是否为“完美Excel”并复制到工作表Sheet5中。注意,数组变量必须声明为Variant型。

    使用For循环

    使用For循环,也可以实现上图3的结果。代码如下:

    Sub CopyDataByFor()

        Dim rng As Range

        Dim i As Long

        Dim j As Long

        Dim row As Long

        Set rng = Sheet4.Range("A1").CurrentRegion

        row = 1

        For i = 1 To rng.Rows.Count

            If rng(i, 1).Value = "完美Excel" Then

                For j = 1 To rng.Columns.Count

                    Sheet5.Cells(row, j).Value =rng(i, j).Value

                Next j

                row = row + 1

            End If

        Next i

    End Sub

    使用自动筛选

    使用自动筛选,不必使用很多次循环,也能实现上图3所示的结果。代码如下:

    Sub CopyDataByAutoFilter()

        Dim rng As Range

        Set rng = Sheet4.Range("A1").CurrentRegion

        '删除已存在的筛选

        rng.AutoFilter

        '应用自动筛选

        rng.AutoFilter Field:=1, Criteria1:="完美Excel"

        '复制数据

        Sheet4.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy

        Sheet5.Range("A1").PasteSpecialxlPasteValues

        '删除筛选

        rng.AutoFilter

    End Sub

    使用高级筛选

    高级筛选能够直接将满足条件的数据复制到指定的位置,但需要先指定条件。如下图4所示,工作表Sheet10中的单元格区域A1:B7为数据区域,单元格区域D1:D2为筛选条件,需要筛选出名称为“完美Excel”的数据至工作表Sheet11中。

    a7cb626b566279457b3a258b7b25e166.png

    图4

    代码如下:

    Sub CopyDataByAdvancedFilter()

        Dim wksData As Worksheet

        Dim wksFilter As Worksheet

        Dim rngData As Range

        Dim rngCriteria As Range

        Set wksData =ThisWorkbook.Worksheets("Sheet10")

        Set wksFilter =ThisWorkbook.Worksheets("Sheet11")

        '清空要放置复制数据的工作表

        wksFilter.Cells.Clear

        '删除已存在的筛选

        If wksData.FilterMode = True Then

            wksData.ShowAllData

        End If

        '获取数据区域

        Set rngData =wksData.Range("A1").CurrentRegion

        '条件区域

        Set rngCriteria =wksData.Range("D1:D2")

        '筛选并获取满足条件的数据

        rngData.AdvancedFilterAction:=xlFilterCopy, _

            CriteriaRange:=rngCriteria, _

           CopyToRange:=wksFilter.Range("A1")

    End Sub

    运行代码后的结果如下图5所示。

    9ca2142fc902769ec96ef657d7c9cf9d.png

    图5

    高级筛选还可以处理多个条件,对于同一行中的条件关系为“AND”,对于不同行中的条件关系为“OR”。

    提示

    1. 在使用VBA代码进行复制操作时,我们不需要先选择想要复制的数据,也不需要选择或激活数据所在的工作表。

    2. 在不同的工作表之间复制,或者在不同的工作簿之间复制时,在前面加上相应的工作表或工作簿名称。

    3. 在复制前关闭Excel的某些功能,可以加速复制操作。一般,在复制代码前,使用下面的代码关闭相关的功能:

    Application.Calculation =xlCalculationManual

    Application.DisplayStatusBar =False

    Application.EnableEvents =False

    Application.ScreenUpdating =False

    在复制代码完成后,再恢复相关的功能:

    Application.Calculation =xlCalculationAutomatic

    Application.DisplayStatusBar =True

    Application.EnableEvents = True

    Application.ScreenUpdating =True

    相关文章链接:

    Excel VBA解读(49):复制或剪切单元格——Copy方法与Cut方法

    Excel VBA解读(52):自动筛选方法——AutoFilter方法

    Excel VBA解读(53):高级筛选——AdvancedFilter方法

    9de08f687ef09d77601ca5dc1773f2e6.png

    展开全文
  • VBA筛选AutoFilter用法

    万次阅读 多人点赞 2017-06-24 23:42:10
    在面对大量数据时,我们可以使用Excel的筛选功能,滤出我们需要的信息。在本文中,我们先从Excel中的“筛选”命令谈起。  如下图所示的工作表,将活动...上述操作录制的VBA代码如下: Sub Macro1() ' ' Macro1

            在面对大量数据时,我们可以使用Excel的筛选功能,滤出我们需要的信息。在本文中,我们先从Excel中的“筛选”命令谈起。

            如下图所示的工作表,将活动单元格置于任一数据单元格中,单击功能区中的“排序和筛选”中的“筛选”命令,可以看到表头单元格中出现了筛选下拉箭头。


     

    上述操作录制的VBA代码如下:

    Sub Macro1()
    '
    ' Macro1 Macro
    '
     
    '
        Selection.AutoFilter
    End Sub

            接着操作。单击内容为“语文”的下拉箭头(即表头第3列),选择“数字筛选——大于(G)…”,在“自定义自动筛选方式”对话框的“显示行”中,第一个组合框左侧选择“大于或等于”,右侧输入“80”,第二个组合框左侧选择“小于”,右侧输入“90”,即筛选语文分数大于或等于80且小于90的数据,结果如下图所示。


    制的代码如下:

    Sub Macro2()
    '
    ' Macro2 Macro
    '
     
    '
        Selection.AutoFilter
       ActiveSheet.Range('$A$1:$F$19').AutoFilter Field:=3,Criteria1:='>=80', _
            Operator:=xlAnd,Criteria2:='<90'
    End Sub

            观察上面录制的代码,可以看出,Excel VBA使用AutoFilter方法来实现“筛选”功能,并提供了一系列可选的参数来进一步执行筛选操作。

    AutoFilter方法的语法及说明

    下面是Range对象的AutoFilter方法的语法:

    Range对象.AutoFilter(Field,Criterial1,Operator,Criteria2,VisibleDropDown)

    说明:

    1. 参数Field,指定想要基于筛选的字段的整数偏移量。从列表的左侧算起,最左侧的字段是字段一。

    2. 参数Criterial1,指定判断条件(为字符串)。使用“=”查找空字段,或者使用“<>”查找非空字段。如果忽略该参数,那么判断是全部。如果参数OperatorxlTop10Items,那么参数Criterial1指定项目的数量。

    3. 参数Operator,指定筛选的类型,为XlAutoFilterOperator常量之一:

    • xlAnd:值为1Criteria1Criteria2的逻辑与。

    • xlOr:值2Criteria1Criteria2的逻辑或。

    • xlTop10Items:值3。显示最大值的项(在Criteria1中指定项目数)。

    • xlBottom10Items:值4。显示最小值的项(在Criteria1中指定项目数)。

    • xlTop10Percent:值5。显示最大值的项(在Criteria1中指定百分比)。

    • xlBottom10Percent:值6。显示最小值的项(在Criteria1中指定百分比)。

    • xlFilterValues:值7。筛选值。

    • xlFilterCellColor:值8。单元格的颜色。

    • xlFilterFontColor:值9。字体颜色。

    • xlFilterIcon:值10。筛选图标。

    • xlFilterDynamic:值11。动态筛选。

    • 参数Criteria2,指定第二个判断条件(字符串),使用Criterial1Operator构建复合判断条件。

    • 参数VisibleDropDown,设置为True则显示所筛选字段的自动筛选下拉箭头;设置为False则隐藏所筛选字段的自动筛选下拉箭头。默认为True

    • 如果忽略所有参数,那么AutoFilter方法简单地切换指定区域的自动筛选下拉箭头的显示。

     

    示例1:移除自动筛选提供的下拉箭头

            在Excel中使用自动筛选时,会在每列顶部都添加一个下拉箭头以获取相应的筛选项。有时,我们只需要使用其中某些字段的下拉箭头,不需要其它字段带有下拉箭头,以免误操作这些字段。例如,上面的示例中,我们只需要代表科目的语文、数学、英语、历史字段有下拉箭头,而移除列A、列B中的下拉箭头。代码如下:

    Sub testAutoFilter1()
        Range('A1').AutoFilter Field:=1,VisibleDropDown:=False
        Range('A1').AutoFilter Field:=2,VisibleDropDown:=False
    End Sub

    即,将相应列字段的参数VisibleDropDown设置为False

    执行后的效果如下图:

     

    示例2:一次执行多个列字段的筛选

    仍以本文开头的工作表为例,要求得到语文成绩大于等于80的男生的数据记录。代码如下:

    Sub testAutoFilter2()
        Range('A1').AutoFilter Field:=2,Criteria1:='=男'
        Range('A1').AutoFilter Field:=3,Criteria1:='>=80'
    End Sub

     

    示例3:复制筛选结果

    将示例2中得到的结果复制到以单元格H21开头的区域中。代码如下:

    Sub testAutoFilter3()
        Dim lngLastRow As Long
       
        '找到工作表中最后一行
        lngLastRow = Range('A' &Rows.Count).End(xlUp).Row
       
        '按条件执行自动筛选
        Range('A1').AutoFilter Field:=2,Criteria1:='=男'
        Range('A1').AutoFilter Field:=3,Criteria1:='>=80'
        
        '将筛选后的结果复制到指定位置
        Range('A1:F' &lngLastRow).Copy Range('H21')
    End Sub

    可以看出,Copy方法仅复制可见单元格中的内容。

     

    示例4:删除筛选出的数据

    如下图所示的工作表,我们要删除列A中单元格内容为“0”的数据行。

    此时,我们可以使用AutoFilter方法筛选出这些行,然后进行删除。代码如下:

    Sub testAutoFilter4()
        Dim rng As Range
       
        '设置筛选区域
        Set rng = Range('A1:B10')
       
        '如果开启了筛选模式则关闭该模式
        If ActiveSheet.AutoFilterMode = True Then
            ActiveSheet.AutoFilterMode = False
        End If
       
        '筛选列A中内容为0的单元
        rng.AutoFilter Field:=1,Criteria1:='0'
       
        '删除筛选出来的行
        With rng
            .Offset(1).Resize(.Rows.Count -1).SpecialCells(xlCellTypeVisible).Delete Shift:=xlShiftUp
            '关闭筛选模式
            .Worksheet.AutoFilterMode = False
        End With
    End Sub

    您可能注意到代码中出现了一些我们前面的文章中没有提到的新属性和方法,下面来作些解释。

    • AutoFilterMode属性属于Worksheet对象(后续文章中我们将会详细讲解Worksheet对象的属性和方法),用来获取工作表中用户是否使用了自动筛选,或者用来设置工作表中使用自动筛选。如果其值为True,那么表明工作表中当前显示有自动筛选下拉箭头,即使用了自动筛选功能。如果设置其值为False,则取消工作表中的自动筛选,即移除自动筛选的下拉箭头。

    • Delete方法用来删除单元格区域,使用参数Shift来移动单元格已取替被删除的单元格。将该参数值设置为xlShiftUp指明将单元格往上移来替换被删除的单元格。

    • 从代码运行中我们发现,进行自动筛选后,使用Rows.Count统计时仍然会统计隐藏的行。

    代码运行后的结果如下图。

    也可以参照下面的视频来加深理解。


     

    示例5:根据当前单元格内容筛选数据

    如下图所示的工作表,我们要筛选出和当前单元格内容相同的单元格所在的数据行。

    例如,当前单元格为单元格B7,当运行程序后,会筛选出与单元格B7中的内容(即“一班”)相同的单元格所在的数据行,所需效果如下图:

    代码如下:

    Sub testAutoFilter5()
        Dim lngColNum As Long
       
        '计算当前单元格在区域中的列号
        lngColNum = ActiveCell.Column -(ActiveCell.CurrentRegion.Column - 1)
       
        '筛选
        Selection.AutoFilter Field:=lngColNum,Criteria1:=ActiveCell
       
    End Sub

    注意到本代码中使用了一个技巧,即代码:

        lngColNum = ActiveCell.Column -(ActiveCell.CurrentRegion.Column - 1)

    当单元格区域不是以列A为第1列时,可以准确地计算出当前单元格在所处区域中的列号,从而将其运用到接下来的AutoFilter方法的参数Field中。

     

    示例6:根据当前单元格内容实时筛选数据并将数据粘贴到指定位置

    本示例将示例3和示例5结合,实时筛选与当前单元格内容相同的数据并将数据复制到指定位置。

    仍以示例5的工作表为例。当活动单元格处于A2:C9中时,能够实时对数据进行筛选,并将筛选出来的数据复制到以单元格A13开头的单元格区域中。

    要实时筛选数据,必须结合工作表事件代码。即,我们的代码放置在了工作表模块的Worksheet_SelectionChange事件(将在Worksheet对象中介绍其详细用法)中:

    Private SubWorksheet_SelectionChange(ByVal Target As Range)
        Dim lngColNum As Long
        Dim lngLastRow As Long
        Dim rng As Range
     
        '如果开启了筛选模式则关闭该模式
        If ActiveSheet.AutoFilterMode = True Then
            ActiveSheet.AutoFilterMode = False
        End If
       
        '设置当前单元格与单元格区域A2:C9相重合的单元格
        Set rng = Intersect(Target,Range('A2:C9'))
        '找到工作表中数据所在的最后行
        lngLastRow = Range('A' &Rows.Count).End(xlUp).Row
       
        '如果工作表中第9行外还有数据则清除
        If lngLastRow > 9 Then
            Range('A13:C' &lngLastRow).Value = ''
        End If
       
        If Not rng Is Nothing Then
            '计算当前单元格在区域中的列号
            lngColNum = ActiveCell.Column -(ActiveCell.CurrentRegion.Column - 1)
       
            '筛选
            Selection.AutoFilter Field:=lngColNum,Criteria1:=ActiveCell
            '关闭事件响应
            Application.EnableEvents = False
            Range('A2:C9').CopyRange('A13')
        End If
     
        '关闭筛选模式
        ActiveSheet.AutoFilterMode = False
        '开启事件响应
        Application.EnableEvents = True
    End Sub

            注意,上述代码必须放置在数据所在工作表模块中。此时,当活动单元格处于该工作表A2:C3区域中时,会自动筛选与活动单元格内容相同的单元格数据,并复制粘贴到以单元格A3开始的区域中。

    下面是一段简短的演示视频:

     

    在代码中,我们使用了语句:

        Application.EnableEvents = False

    来关闭事件响应。因为我们的代码是靠事件实时响应来达到动态选择复制的效果,如果在复制前不关闭事件响应,那么复制操作将会引发SelectionChange事件,会达不到我们想要的结果,因此,先关闭事件响应,复制完后再开启,以实现我们再次选择单元格时数据的变化。我们会在Application对象中详细讲解关于EnableEvents属性的内容。


    转自:http://www.360doc.com/content/17/0624/23/44723068_666296316.shtml

    展开全文
  • 工作中,筛选条件肯定不止一个,有时候要筛选第一列,第二列,而不是某一个固定的列的条件 以上的ABCDEF列都有可能被当成筛选对象 代码如下 Sub chaifenshuju() Dim sht As Worksheet Dim k, i, j As Integer Dim irow ...
  • 在一个工作簿中,想对某一列做筛选,并且拆分到后面的工作表里,通用代码如下: Sub chaifenshuju() Dim sht As Worksheet Dim k, i, j As Integer Dim irow As Integer '这个说的是一共多少行 Dim l As Integer Dim sht...
  • excel用宏如何筛选日期 Excel自动筛选宏 (Excel AutoFilter Macros)There are two types of AutoFilters in Excel – worksheet AutoFilters, and List (Table) AutoFilters. If you're using Excel AutoFilter ...
  • 函数作用:自动建立多级目录.........................86 '72.函数作用:统计经筛选后符合条件的记录条数...........87 '73.函数作用:复制单元格列高与栏宽.....................87 '74.函数作用:取消隐藏工作表(包括...
  • 今天第一次尝试使用Excel宏。 要实现的功能是:1个xls文件中,有2个工作表。...整个过程中,遇到了一些问题,在网上找,试验,解决了部分问题。 1)判断工作表是否处于筛选模式  If Worksheets("Sheet1")....
  • 一般的数据透视表,修改原表数据后,需要手动刷新才可以更新计算,本文通过几步简单的操作,来实现自动计算。 情况一:透视表与原始表格在同一个工作表 普通表格转换成为动态表 点击表格中的任意一个单元格,在...
  • 011:混乱字符串中取电话号码 012:如何批量删除多个括号内的数据 013:多个关键词查找替换 014:如何获取字符串中最后出现的连续数字 015:Excel与西式排名 016:Excel与中式排名 017:Excel与分类排名 018:...
  • Excel中删除重复数据(用VBA代码)

    万次阅读 2012-03-21 12:52:10
    请仔细阅读修改相关数据。我推荐使用第二种方法,是我修改的,很好用,第三种情况用得比较少。  第一种情况保留不重复的记录行,重复的只保留一行。 1、打开有重复数据的EXCEL 2、Alt+F11 打开宏的VB编辑器 3...
  • excel自动筛选 在Excel自动筛选器中隐藏箭头 (Hide Arrows in Excel AutoFilter) When you turn on the filter in an Excel worksheet list, or if you create a named Excel table, each cell in the heading row ...
  • 目录 环境说明逻辑结构效果说明及截图①. 安装SecureCRT②.... 自动生成图表邮件发送 环境说明 系统: Windows Server 2003, Windows Server 2008 Windows Server 2003上目录结构: Windows Server 2...
  • 因为我用了coremail通讯录插件,每次重启outlook插件就会把下边框住的地方去掉,请问有没有方法可以用vba在outlook中启动后把它勾上? ![图片说明]...
  • 分享成果,随喜真能量... 174:如何利用VBA代码,判断是否为空表,如果为空表则使用Delete方法删除NO. 175:利用VBA的自定义函数,判断工作表是否存在VBA过程代码174:如何利用VBA代码,判断是否为空表,如果为空表...
  • VBA中,如果不想保存代码,可以保存为xlsx,即可自动删除其中VBA代码,反之则保存为XLSM文件。 07版的Office Excel,能打开编辑07版(后缀.xlsx)的Excel文件,也能打开编辑03版(后缀.xls)的Excel文件,都不会...
  • Excel2016中如何取消设置的筛选条件

    千次阅读 2019-06-19 14:46:51
    在一张大型复杂的Excel表格中,可以通过强大的筛选功能迅速找出符合条件的数据,而其他不满足条件的数据,Excel工作表会自动将其隐藏。 在设置了数据筛选后,如果想还原到原始数据表中,需要取消设置的筛选条件,...
  • 通过员工培训和自我提升,掌握和使用excel数组公式和VBA自动化,能为员工节省巨大的时间和精力,提高工作附加值。同时作为公司效率化和系统化改善的一部分,为公司效益带来显著提升。以下通过一些案例,展示利用...
  • 经常要用到Excel表格进行信息筛选和处理,今天遇到的情况就是,明明自动筛选已经设置为了“空白”,但是仍然返回了”非空白数据”。 产生原因是由于,合并单元格造成的,在Excel内部出现的合并单元格,只有第一个行...
  • 文章目录一、场景需求二、思路三、操作3.1 单个单元格键入公式3.2 批量自动填充公式3.3 筛选排序 一、场景需求   子域名收集过程中有很多收集的子域数值过大往往是测试间残留的地址,对于我们访问正常的域名存在...
  • VBA常用技巧

    2013-03-25 21:10:12
    技巧36复制自动筛选后的数据区域89 技巧37使用高级筛选获得不重复记录91 技巧38工作表的保护与解除保护92 技巧39奇偶页打印95 第3章Wordbook(工作簿)对象97 技巧40工作簿的引用方法97 40-1使用工作簿的名称97 40-2...
  • 一 问题描述,列非空数据重排--进化:删除非空数据后重排 (1)原始问题 我想把下表这样的一些数据,转化为,每列数据都往上对齐 数据里暂时没有空行,但实际上如果有空行,我是想删除空行的 肯定不能手动搞吧,...
  • 收藏 | 27个Excel vba实例汇总(附赠VBA教程) 大致分类如下: 单元格操作 实例(1)- 批量制作工资表头 实例(5)- 快速合并n多个相同值的单元格 实例(9)- 批量插入、删除表格中的空行 实例(11)- 拆分单元格并自动填充 ...
  • '删除第一列与第四列 Columns(1).Delete Shift:=xlToLeft Columns(3).Delete Shift:=xlToLeft '去掉含不计入综测的科目 有效范围 = 2 * (i - 3) / 3 j = 3 While Cells(3, j) <> "" 计数 = 0 For i = 6 ...
  • Excel VBA技巧实例手册

    2016-07-28 22:29:39
    技巧058设置自动筛选 技巧059遍历筛选结果 技巧060获取筛选的条件 第4章 使用Worksheet对象 4.1 操作工作表 技巧061插入工作表 技巧062复制工作表 技巧063统计工作表的个数 技巧064同时选择多个工作表 技巧065...
  • VBA 数据透视表的创建

    千次阅读 2021-01-21 15:21:37
    数据透视表在刷新或移动域时自动设置格式 .DisplayErrorString 读/写 Boolean False 如果数据透视表在有错误的单元格中显示用户自定义的错误字符串,则该值为 True。 .ErrorString 返回...
  • 写一个可以自动获得并且筛选出几万个具有迭代过程的文件中获取最终的工程文件 内容: 1、 用cmd命令行获取基本数据信息 2、 用python排除无效信息(根据文件名,时间…) 3、 用vba写一个excel插件用于录入信息,...

空空如也

空空如也

1 2 3 4 5 ... 20
收藏数 935
精华内容 374
热门标签
关键字:

vba自动筛选并删除