多個單元格自動過濾

我有一個選擇 C ??列中的非空單元格的代碼。現在如果我想在我的自動過濾器中選擇這些單元格，它只會顯示 OutRng 的第一個找到的值。我該如何解決？

Sub SelectNonBlankCells()

    Sheets("Rekenblad").Select

    Dim Rng As Range
    Dim OutRng As Range
    Dim xTitle As String
    SearchCol = "10"

    On Error Resume Next

    xTitle = Range("C:C")
    Set InputRng = Range("C:C")

    For Each Rng In InputRng
        If Not Rng.Value = "" Then
            If OutRng Is Nothing Then
                Set OutRng = Rng
            Else
                Set OutRng = Application.Union(OutRng, Rng)
            End If
        End If
    Next

    If Not (OutRng Is Nothing) Then
        OutRng.Copy

        Sheets("Plakken").Select
        ActiveSheet.Range("$A$1:$K$13").AutoFilter Field:=10, Criteria1:=Array(OutRng) _
            , Operator:=xlFilterValues
    End If
End Sub

uj5u.com熱心網友回復：

對多個（一組）值進行自動過濾

• Range("C:C") 這是一個相當大的范圍，可能需要很長時間才能得到處理。
• OutRng.Copy 除非您打算將其復制到某個地方，否則毫無意義。
• 由于OutRng被宣告為范圍，因此Array(OutRng)是一個包含一個元素的陣列，該元素是實際范圍（物件，而不是值）。
• 如果一個范圍包含多個單元格并且是連續的（單個范圍，一個區域），您可以使用，OutRng.Value但這是一個基于一維的二維陣列，在這種情況下（它是一列陣列）可以轉換為一維陣列-基于陣列的使用Application.Transpose(OutRng.Value)有其局限性。但是，由于您已將各種單元格組合成一個范圍，因此預計該范圍是不連續的（有多個區域，是一個多范圍），您又一次陷入了死胡同。
• 無論如何，這是一次有趣的嘗試（恕我直言）。

Option Explicit

Sub FilterRange()
    
    ' Source
    Const sName As String = "Rekenblad"
    Const sCol As String = "C"
    Const sfRow As Long = 2
    ' Destination
    Const dName As String = "Plakken"
    Const dField As Long = 10
    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Create a reference to the Source Range ('srg').
    Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
    'If sws.AutoFilterMode Then sws.AutoFilterMode = False
    Dim slRow As Long: slRow = sws.Cells(sws.Rows.Count, sCol).End(xlUp).Row
    Dim srCount As Long: srCount = slRow - sfRow   1
    If srCount < 1 Then Exit Sub ' no data
    Dim srg As Range: Set srg = sws.Cells(sfRow, sCol).Resize(srCount)
    
    ' Write the values from the Source Range to the Source Array ('sData').
    Dim sData As Variant
    If srCount = 1 Then ' one cell
        ReDim sData(1 To 1, 1 To 1): sData(1, 1) = srg.Value
    Else ' multiple cells (in column)
        sData = srg.Value
    End If
    
    ' Write the unique values from the Source Array to the keys
    ' of a dictionary ('dict').
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare ' A = a
    Dim Key As Variant
    Dim r As Long
    For r = 1 To srCount
        Key = sData(r, 1)
        If Not IsError(Key) Then ' not error value
            If Len(Key) > 0 Then ' not blank
                dict(CStr(Key)) = Empty
            'Else ' blank
            End If
        ' Else ' error value
        End If
    Next r
    If dict.Count = 0 Then Exit Sub ' only blanks and error values

    ' Filter the Destination Range ('drg') by the values in the dictionary.
    Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
    If dws.AutoFilterMode Then dws.AutoFilterMode = False ' remove previous
    Dim drg As Range: Set drg = dws.Range("A1").CurrentRegion
    ' If the previous line doesn't work, use another way,
    ' or revert to the static:
    'Set drg = dws.Range("A1:K13")
    drg.AutoFilter dField, dict.Keys, xlFilterValues
    'dws.activate

End Sub

uj5u.com熱心網友回復：

我認為您必須將范圍值傳遞給陣列：

cpt = 0
For Each cell In OutRng 
    ReDim Preserve MyArray(cpt)
    MyArray(cpt) = cell.Text
    cpt= cpt  1
Next

Sheets("Plakken").Range("$A$1:$K$13").AutoFilter Field:=10, Criteria1:=MyArray _
            , Operator:=xlFilterValues

標籤：擅长 vba

上一篇：用于連接的ExcelVBA函式未回傳有效單元格結果（但debug.print顯示正確的字串）

下一篇：將范圍轉換為表格