Excel（宏）：理解代码 - 获取唯一值（行和列）以在宏中使用

Question

（首先，我知道this 可能对我很有效 - 我正试图了解其他地方的一段代码发生了什么。）

我有一个连接到按钮的宏来隐藏“rHFilter”范围内不包含我想要的值的列和行（无论单元格“M2”的下拉菜单中的内容是什么）。为了获取下拉列表的值，我试图检查我的范围“rHFilter”中的所有值。 enter image description here

我的代码中有重复项 我的“strFilter”变量中有多个值的实例，但我不明白这个位在做什么，确切地说，它允许重复：

    For Each c In Range("rHFilter").Cells
    If Application.CountIf(Range(Cells(3, 2), c), c.Value) = 1 Then
        strFilter = strFilter & "," & c.Value
    End If
    Next c

这似乎是从一个范围中获取唯一值以在我的宏中使用的最小方法 - 但如果我无法使其工作，我正在考虑尝试其他页面中的“集合”代码。谁能帮帮我？

顺便说一句，我也不明白这是在做什么：

'=========
'What is this statement supposed to do?
'If Application.CountIf(ThisWorkbook.Sheets(1).Columns(2), "-") _
   = Range("rHFilter").Rows.Count Then Exit Sub
'=========

这里是更大的代码（任何感兴趣的人）：

    Sub SetrHFilterRange()
    On Error Resume Next
    Application.ScreenUpdating = False
    strSN = ActiveSheet.name
    Set ws = Sheets(strSN)

    ' Get the Last Cell of the Used Range
    ' Set lastCell = ThisWorkbook.Sheets(1).usedRange.SpecialCells(xlCellTypeLastCell)
    Set lastCell = ws.Columns("B:G").Find("*", ws.[B3], xlValues, , xlByRows, xlPrevious)
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Set usedRange = Range("B3:G" & lastRow)

    ' Reset Range "rHFilter" from Cell C2 to last cell in Used Range
    ThisWorkbook.Names.Add name:="rHFilter", RefersTo:=usedRange

    ' Set filtering cell value and formatting
    With Cells(2, 13)
        .Value = "-"
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, Formula1:="=""-"""
        .FormatConditions(1).Interior.ColorIndex = 44
        .Interior.ColorIndex = 17
    End With

    strFilter = "-"

    For Each c In Range("rHFilter").Cells
        If Application.CountIf(Range(Cells(3, 2), c), c.Value) = 1 Then
            strFilter = strFilter & "," & c.Value
        End If
    Next c

    With Cells(2, 13).Validation
        .Delete
        .Add Type:=xlValidateList, Formula1:=strFilter & ",Blank Cells"
        .InCellDropdown = True
    End With

    strFilter = ""
    Application.ScreenUpdating = True

    On Error GoTo 0

End Sub

Sub SetrHFilter()

    strSN = ActiveSheet.name
    Set ws = Sheets(strSN)

    If lastCell Is Nothing Then
        Set lastCell = ws.Columns("B:G").Find("*", ws.[B3], xlValues, , xlByRows, xlPrevious)
    End If

    On Error Resume Next
'=========
    'What is this statement supposed to do?
    'If Application.CountIf(ThisWorkbook.Sheets(1).Columns(2), "-") _
       = Range("rHFilter").Rows.Count Then Exit Sub
'=========

    ' reset unhide in case the user didn't clear
    ThisWorkbook.Sheets(1).Columns.Hidden = False
    ThisWorkbook.Sheets(1).Rows.Hidden = False

    eName = Cells(2, 13).Value
    If eName = "-" Then Exit Sub

    ' Speed the code up changing the Application settings
    With Application
        lCalc = .Calculation
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    FilterRowsNCols:

    ' Hide columns if cells don't match the values in filter cell
    If eName <> "Blank Cells" Then
        For Each hFilterCol In Range("rHFilter").Columns
            Set fName = hFilterCol.Find(what:=eName, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
                                                        SearchDirection:=xlNext, MatchCase:=False)
            If fName Is Nothing Then 'not found
                hFilterCol.EntireColumn.Hidden = True
            End If
        Next hFilterCol
    Else
        'Do something if the user selects blank - but what??
    End If

    If eName <> "Blank Cells" Then
        For Each hFilterRow In Range("rHFilter").Rows
            Set fName = hFilterRow.Find(what:=eName, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
                                                        SearchDirection:=xlNext, MatchCase:=False)
            If fName Is Nothing Then 'not found
                hFilterRow.EntireRow.Hidden = True
            End If
        Next hFilterRow
    Else
        'Do something if the user selects blank - but what??
    End If

    Set lastCell = Nothing

    If bFilter = False Then
        bFilter = True
        GoTo FilterRowsNCols
    End If

    ' Change the Application settings back
    With Application
        .Calculation = lCalc
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    On Error GoTo 0


    End Sub

    Sub ResetrHFilter()
    On Error Resume Next
    ThisWorkbook.Sheets(1).Columns.Hidden = False
    ThisWorkbook.Sheets(1).Rows.Hidden = False
    SetrHFilterRange
    On Error GoTo 0

    End Sub

===================================

编辑

在阅读和测试 Scott 的回答后添加了以下编辑：

我将代码更改为：

strFilter = "-"

For Each c In Range("rHFilter").Cells
    If Application.CountIf(Range(Cells(3, 2), c), c.Value) = 1 Then
        strFilter = strFilter & "," & c.Value
    End If
Next c

With Cells(2, 13).Validation
    .Delete
    .Add Type:=xlValidateList, Formula1:=strFilter & ",Blank Cells"
    .InCellDropdown = True
End With

到这里：

strFilter = "-"
Set uniqCol = New Collection

For Each c In Range("rHFilter").Cells
    If Not IsNumeric(c.Value) And Not IsDate(c.Value) Then
       uniqCol.Add c.Value, CStr(c.Value)
    End If
Next c
For Each itmVal In uniqCol
    strFilter = strFilter & "," & itmVal
Next

With Cells(3, 34).Validation
    .Delete
    .Add Type:=xlValidateList, Formula1:=strFilter & ",Blank Cells"
    .InCellDropdown = True
End With

谢谢你，斯科特

Answer 1

这是一个使用 Collection 返回唯一值数组的函数。

Function UniqueArray(rng As Range) As Variant()
    Dim cUnique As Collection
    Dim Cell As Range
    Dim vNum As Variant
    Dim tempArr() As Variant
    Dim j As Long

    Set cUnique = New Collection

    On Error Resume Next
        For Each Cell In rng.Cells
            cUnique.Add Cell.Value, CStr(Cell.Value)
        Next Cell
    On Error GoTo 0

    ReDim tempArr(0 To cUnique.Count - 1)
    j = 0
    For Each vNum In cUnique
        tempArr(j) = vNum
        j = j + 1
    Next vNum

    UniqueArray = tempArr
End Function

你可以这样称呼它

Dim tArr as Variant
tArr = UniqueArray("rHFilter")

然后循环遍历 tArr 以获取您的唯一值。