（首先，我了解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
==================================
阅读＆amp;后添加了以下编辑内容测试斯科特的答案：
我改变了我的代码：
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
谢谢你，Scott
答案 0 :(得分：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获取您的唯一值。