excel vba 將篩選的值另外存至其他儲存格

 

Sub doFilterGroup_13_整理()

    Dim d, rng As Range, cel As Range

    Set d = CreateObject("scripting.dictionary")   '建立Dictionary物件

'先將目的地的儲存格清成空白    

With Worksheets("執行")

        Set rng = .[q:q]

        rng.Value = ""

    End With

    With Worksheets("13_整理")

        Set rng = .[b:b]      '設定B欄為要篩選資料的範圍

        .Activate

      End With

    '將資料塞入Dictionary的物件中

    For Each cel In rng

       If cel.Value <> "" Then d(cel.Value) = ""  

    Next

    '將篩選後的不重複值存入Sheets("執行").[Q1]中

    Sheets("執行").[Q1].Resize(d.Count) = Application.Transpose(d.keys)

        

End Sub