Excel VBA – 查找无隐藏单元格的唯一值

我有一个工作簿，我想应用filter，然后采取该filter的所有值，并创build它们作为variables。

我目前有这样的：

Option Explicit Sub CreateUniqueList() Dim lastrow As Long ActiveSheet.Name = "Raw Data" Dim ws As Worksheet Set ws = Sheets("Raw Data") Dim Champs As Worksheet Set Champs = ActiveWorkbook.Sheets.Add(After:= _ ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)) Champs.Name = "Unique Champions" ws.Activate lastrow = Cells(Rows.Count, "D").End(xlUp).Row ActiveSheet.Range("D6:D" & lastrow).AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=Champs.Range("A1"), _ Unique:=True Dim Champ1 As String Dim Champ2 As String Dim Champ3 As String Dim Champ4 As String Dim Champ5 As String Dim Champ6 As String Dim Champ7 As String Dim Champ8 As String Dim Champ9 As String Dim Champ10 As String Dim Champ11 As String Dim Champ12 As String Dim Champ13 As String Dim Champ14 As String Dim Champ15 As String Champs.Activate Champ1 = Cells(2, 1).Value Champ2 = Cells(3, 1).Value Champ3 = Cells(4, 1).Value Champ4 = Cells(5, 1).Value Champ5 = Cells(6, 1).Value Champ6 = Cells(7, 1).Value Champ7 = Cells(8, 1).Value Champ8 = Cells(9, 1).Value Champ9 = Cells(10, 1).Value Champ10 = Cells(11, 1).Value Champ11 = Cells(12, 1).Value Champ12 = Cells(13, 1).Value Champ13 = Cells(14, 1).Value Champ14 = Cells(15, 1).Value Champ15 = Cells(16, 1).Value End Sub 

这将selectWorksheet ws所有唯一值并将其粘贴到A列中的Worksheet Champs中。然后从那里设置variables。 这工作，但是我希望用户首先筛选他们想要在列D中的值，然后它只采取这些独特的价值观。

目前发生的事情是用户应用filter，然后运行macros，但它仍然拿起所有的唯一值，即使没有包括在filter中。

我的问题是我怎样才能改变这部分的代码不包括隐藏的行？

 lastrow = Cells(Rows.Count, "D").End(xlUp).Row ActiveSheet.Range("D6:D" & lastrow).AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=Champs.Range("A1"), _ Unique:=True 

此外，如果有任何方法来清理代码，所以我不需要更多的线路，这种知识将是受欢迎的。

谢谢

Answer 1

当您应用高级filter时，以前的自动filter将不复存在。 所以我们不能混合两个filter。 但是，我们可以删除高级filter，并使用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