Excel VBA - 查找 none 个隐藏单元格的唯一值

Question

我有一个工作簿，我想应用过滤器，然后获取该过滤器的所有值并将它们创建为变量。

我目前有这个：

Option Explicit

Sub CreateUniqueList()

Dim lastrow As Long

ActiveSheet.Name = "Data"

Dim ws As Worksheet
Set ws = Sheets("Data")

Dim uniq As Worksheet
Set uniq = ActiveWorkbook.Sheets.Add(After:= _
    ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count))
uniq.Name = "Unique"

ws.Activate

lastrow = Cells(Rows.Count, "D").End(xlUp).Row

    ActiveSheet.Range("D6:D" & lastrow).AdvancedFilter _
    Action:=xlFilterCopy, _
    CopyToRange:=uniq.Range("A1"), _
    Unique:=True

Dim uniq1 As String
Dim uniq2 As String
Dim uniq3 As String
Dim uniq4 As String


uniq.Activate

uniq1 = Cells(2, 1).Value
uniq2 = Cells(3, 1).Value
uniq3 = Cells(4, 1).Value
uniq4 = Cells(5, 1).Value

End Sub

这会选择工作表 ws 中的所有唯一值，并将它们粘贴到工作表 uniq 的 A 列中。然后从那里设置变量。这行得通，但是我希望用户首先在 ws D 列中过滤他们想要的值，然后只采用这些唯一值。

当前发生的情况是用户应用过滤器，然后运行宏，但它仍然会获取所有唯一值，即使是那些不包含在过滤器中的值。

我的问题是如何更改这部分代码以不包含隐藏行？

lastrow = Cells(Rows.Count, "D").End(xlUp).Row

ActiveSheet.Range("D6:D" & lastrow).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Champs.Range("A1"), _
Unique:=True

此外，如果有任何方法可以清理代码以便我不需要更多的行，欢迎提供知识。

谢谢

Answer 1

当您应用高级过滤器时，之前的自动过滤器消失了。所以我们不能混合这两个过滤器。但是，我们可以删除高级过滤器并使用 Dictionary.

获取唯一值

Sub CreateUniqueList()
  Dim dict As Object, lastRow As Long, Champ, c
  Set dict = CreateObject("Scripting.dictionary")
  With Sheets("Raw Data")
      lastRow = .Cells(.Rows.count, "D").End(xlUp).row
      For Each c In .Range("D7:D" & lastRow).SpecialCells(xlCellTypeVisible)
        dict(c.text) = 0
      Next
  End With
  Champ = dict.Keys

  ' Now you have the "variables". To create the new sheet:
  With Sheets.Add(After:= Sheets(Sheets.Count))
    .Name = "Unique Champions"
    .Range("A2").Resize(dict.count).Value = Application.Transpose(dict.keys)
    .Range("A1").Value = Sheets("Raw Data").Range("D6").Value
  End With
End Sub

Excel VBA - 查找 none 个隐藏单元格的唯一值

Excel VBA - Find unique values of none hidden cells

excel

vba

unique

filter