简体   繁体   English

VBA 筛选选定的单元格

[英]VBA Filter Selected cells

I am trying to AutoFilter based on SelectedRange criteria.我正在尝试根据 SelectedRange 标准进行自动筛选。 Ex.前任。 user selects cells with "shift" and/or "ctrl", clicks a button, which filters only the values that he had selected.用户使用“shift”和/或“ctrl”选择单元格,单击一个按钮,该按钮仅过滤他选择的值。

    Dim cel As Range
    Dim selectedRange As Range
    Dim arr As String

    Set selectedRange = Application.Selection

    arr = Empty
    For Each cel In selectedRange.Cells
        arr = arr & " " & cel.Value
    Next cel

    x = ActiveCell.Column
    
    lastrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row

    ActiveSheet.Range("$A$10:$DV" & lastrow).AutoFilter Field:=x, Criteria1:=arr, Operator:=xlFilterValues

I am tried populating a string and concatenating characters so that it looks like the line below, which works, but has fixed values:我尝试填充一个字符串并连接字符,使其看起来像下面的行,它有效,但具有固定值:

Range("$A$1:$EZ" & lastrow).AutoFilter Field:=62, Criteria1:=Array("1", "2", "3", "4"), Operator:=xlFilterValues

I've also tried pasting selected values into a range, then transposing and calling the transposed range, however it still did not work.我也试过将选定的值粘贴到一个范围内,然后转置并调用转置的范围,但它仍然不起作用。

Use a delimited string to get the values from the selected range, then split that into an array to use as your criteria.使用带分隔符的字符串从所选范围中获取值,然后将其拆分为一个数组以用作您的条件。

    Dim cel As Range
    Dim selectedRange As Range
    Dim splitstr As String
    Dim arr As Variant
    Dim lastrow As Long
    Dim x As Long
    
    Set selectedRange = Application.Selection

    For Each cel In selectedRange.Cells
        If splitstr = "" Then 'This avoids an empty index
            splitstr = cel.Value
        Else
            splitstr = splitstr & "|" & cel.Value
        End If
    Next cel
    
    x = ActiveCell.Column
    
    lastrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
    arr = Split(splitstr, "|")
    ActiveSheet.Range("$A$10:$DV" & lastrow).AutoFilter Field:=x, Criteria1:=arr, Operator:=xlFilterValues

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM