- 帖子
- 17
- 主題
- 4
- 精華
- 0
- 積分
- 22
- 點名
- 0
- 作業系統
- windows10
- 軟體版本
- windows10
- 閱讀權限
- 10
- 性別
- 男
- 註冊時間
- 2020-11-18
- 最後登錄
- 2022-1-12
|
各位先進大家好,
我利用錄製巨集(在從中修改),篩選出我想要的資料表,另又撰寫另外一份,刪除重複值(並保留最新資料)的VBA
想請教,要如何將兩份程式碼合併,可以在篩選資料過程中,一並剔除重複資料(保留最新資料),
以下是我的程式碼,懇請協助
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 |
|