[發問] 是否可以簡化錄製後的VBA 語法

jsc0518

Dear all,
我使用錄製方式製作VBA
(1).選擇D欄，copy
(2).選擇U欄，選擇性貼上-值
(3).資料(點選工具列)-移除重複項
    ** ActiveSheet.Range("$U$1:$U$20000"). --> 這一段是我用手動改的，因為以後還會有多的資料產出
(4).選擇U欄，copy
(5).選擇P欄，選擇性貼上-值
(6).選擇U欄，清除該欄位資訊



下面是錄製的語法，是否可以再簡化呢？

Sub Repeat()

    Columns("D:D").Select
    Selection.Copy
    Columns("U:U").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveSheet.Range("$U$1:$U$20000").RemoveDuplicates Columns:=1, Header:=xlYes
    Selection.Copy
    Columns("P:P").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Columns("U:U").Select
    Selection.ClearContents


    Range("Q1").Select

End Sub

singo1232001

回復 1# jsc0518

Sub RepeatA()
Columns("U") = Columns("D").Value
Range("U1:U20000").RemoveDuplicates Columns:=1, Header:=xlYes
Columns("P") = Columns("U").Value
Columns("U").ClearContents
End Sub

samwang

回復 1# jsc0518

用字典的寫法，請試看看，謝謝。

Sub test()
Dim Arr, xD, i&
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range("D1:D" & [d65536].End(3).Row)
For i = 1 To UBound(Arr): xD(Arr(i, 1) & "") = "": Next
Range("P1").Resize(xD.Count) = Application.Transpose(xD.keys)
End Sub

jsc0518

回復 2# singo1232001
Dear singo1232001,
您好！感謝您的熱心回復。
語法可以使用，但執行過程中速度很慢，另外只要刪除一欄位內資料，VBA也會跑
謝謝歐

jsc0518

回復 3# samwang
Dear samwang,

您好！感謝您的熱心回覆，語法可以使用。
請教一下
1.哪段是"刪除重複性資料"的語法呢？
2."用字典的寫法"是甚麼意思呢？

Thank you.

samwang

回復 5# jsc0518


沒有刪除重複性的語法，那是字典特性功能之一，從網站內可找到很多相關的資訊，謝謝

singo1232001

回復 5# jsc0518

之前 這個寫法我一直沒搞懂
原先也以為是刪除重複的用法
經過大大提示指點 我也跑去查了資料 終於了解這個意思
https://www.twblogs.net/a/5ca5b36bbd9eee59d332e201
才完全搞明白 他本身是一種添加資料的功能  
但因為字典添加有唯一性(重複的資料會加不進去) 所以就結果來說變成具有篩選重複的效果

另外奉上與大大一樣的寫法
Sub test1()
Dim xD, i&
Set xD = CreateObject("Scripting.Dictionary")
For Each d In Range("D1:D" & [d65536].End(3).Row).Value
xD(d) = "": Next   'xD(d)="" 是一種縮寫 原本是要寫成 xD.Item(d) = ""
Range("P1").Resize(xD.Count) = Application.Transpose(xD.keys)
End Sub
感謝大大指點

jsc0518

回復 7# singo1232001
Hi 感謝您的回覆歐，我試試看！

jsc0518

回復 6# samwang
Hi 謝謝您的資訊，我找看看資料

ML089

這是 D:D 資料複製不重複資料至 P:P，有含表頭


Sub Macro2()
    Columns("D:D").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Columns( "P:P"), Unique:=True
End Sub