VBA 高级过滤唯一值并复制到另一个 sheet

VBA Advanced filter unique values and copy to another sheet

我尝试了多种方法来过滤列中的唯一值(包括空白和内部带有 space 的空白)。我想过滤这些值,然后将它们粘贴到另一个 sheet.

的 a 列中
Sub filter_2()
    With Sheets("ICM flags")

        .Columns("a").AdvancedFilter Action:=xlFilterCopy, copytorange:=Sheets("Flag Update (2)").Range("a2"), Unique:=True

    End With
End Sub

上述方法适用于 .range("a2"),但如果我尝试使用 .range("a1"),我会收到运行时错误 1004 class 的高级过滤方法失败。

我收到运行时错误 1004 class 的高级筛选方法因以下方法失败。

Sub unique_filter()

               Sheets("ICM flags").Columns("a").AdvancedFilter _
                     Action:=xlFilterCopy, _
                        copytorange:=Sheets("Flag Update (2)").Range("a1"), Unique:=True

End Sub

对于上述两种方法以及对 Davesexcel 答案的编辑:

Sub AdvFilter()
Dim ws As Worksheet, sh As Worksheet
Dim rng As Range, Frng As Range

Set sh = Sheets("ICM Flags")
Set Frng = sh.Range("A:A")
Set ws = Sheets("Flag Update (2)")
Set rng = ws.Range("A1")

'Frng.AdvancedFilter Action:=xlFilterCopy, copytorange:=rng, Unique:=True
Frng.AdvancedFilter Action:=xlFilterInPlace, Unique:=True

End Sub

该方法适用于 FilterInPlace 但不适用于 CopyToRange

当我运行你的代码时,它在我这边没有错误。

这是相同的代码,但使用了变量,可能更适合您。

Sub AdvFilter()
    Dim ws As Worksheet, sh As Worksheet
    Dim rng As Range, Frng As Range

    Set ws = Sheets("Flag Update (2)")
    Set rng = ws.Range("A1")
    Set sh = Sheets("ICM flags")
    Set Frng = sh.Range("A:A")

    Frng.AdvancedFilter Action:=xlFilterCopy, copytorange:=rng, Unique:=True

End Sub

问题似乎是由尝试使用 CopyToRange 复制到另一个 sheet 引起的。我通过首先复制到相同的 sheet 然后将这些值复制到 sheet 我希望它们在

上来解决这个问题
Sub AdvFilter() 'filters flags copied from ICM to unique values and pastes  into Flag update sheet.

    Dim ws As Worksheet, sh As Worksheet
    Dim rng As Range, Frng As Range, Prng As Range

    Set ws = Sheets("Flag Update (2)")

    Set sh = Sheets("ICM Flags 1")'destination sheet
    Set Frng = sh.Range("A:A")'filter range
    Set rng = sh.Range("c1")'filter output range


    Frng.AdvancedFilter Action:=xlFilterCopy, copytorange:=rng, Unique:=True
    ws.Columns("a").Value = sh.Columns("c").Value 'Separate copying as the filter didn't like copying to another sheet

End Sub

实际上 目标需要设为活动 sheet,然后您可以从任何其他 sheet 或工作簿

获取唯一值

这是我独特的过滤器上使用的东西。它将从 sheet1 复制并粘贴到 sheet2

Private Sub CommandButton2_Click()
    Dim UserRange As Range
    Sheets("Sheet2").Range("A:A").Clear
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("Sheet1")
    On Error Resume Next
    Set UserRange = Application.Range("A:A")
    On Error GoTo 0
    If UserRange Is Nothing Then
        Exit Sub
    End If     
    UserRange.AdvancedFilter _
        xlFilterCopy, CopyToRange:=Sheets("BOM").Range("A1"), Unique:=True
End Sub