標題: [發問] 如何將篩選程式碼及刪除重複程式碼合併 [打印本頁]

---

作者: lilizzzz    時間: 2020-11-27 11:28     標題: 如何將篩選程式碼及刪除重複程式碼合併

各位先進大家好，

我利用錄製巨集(在從中修改)，篩選出我想要的資料表，另又撰寫另外一份，刪除重複值(並保留最新資料)的VBA

想請教，要如何將兩份程式碼合併，可以在篩選資料過程中，一並剔除重複資料(保留最新資料)，

以下是我的程式碼，懇請協助

[attach]32725[/attach]

Sub 產品種類及時間區間查詢()
'
    Sheets("3P-INSPPROD").Range("A1:AK300000").AdvancedFilter Action:=xlFilterCopy _
        , CriteriaRange:=Range("A1:C3"), CopyToRange:=Range("A7:AK7") _
        , Unique:=False

    ActiveWindow.SmallScroll Down:=-27
    Cells.Select
    Range("J21").Activate
    With Selection.Font
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .TintAndShade = 0
    End With
    With Selection.Font
        .Name = "標楷體"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("E9").Select
End Sub


Sub 刪除重覆值()
'建立字典，把對象賦予dictionary，(等於判斷依據)
Set dic = CreateObject("scripting.dictionary")
'從A列最後一列開始進行篩選: step -1
'如果是從第一列開始會有刪除跳行情況，無法達成刪除重複效果
For i = Range("A65536").End(3).Row To 1 Step -1
'如果A欄數據已經存在字典中(等於重複了)則執行THEN
If dic.exists(Cells(i, "A").Value) Then
'刪除該列
Rows(i).Delete
Else
'若A欄數據未存於字典內，則將其加入字典
dic(Cells(i, "A").Value) = ""
End If
Next i
End Sub

---

作者: hcm19522    時間: 2020-11-27 14:47

類似 參考  https://blog.xuite.net/hcm19522/twblog/589483476

---

作者: 軒云熊    時間: 2020-11-27 20:57

回復 1# lilizzzz

可否把檔案傳上來 感謝

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)