Qin

帖子: 207
主題: 61
精華: 0
積分: 270
點名: 0
作業系統: Vista
軟體版本: office2003
閱讀權限: 20
性別: 女
註冊時間: 2011-3-20
最後登錄: 2023-6-25

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2018-8-30 00:08 | 只看該作者

VBA尋找重複

程式碼是在網上取來套用的,

但搜尋速度實在太慢了.

是否有更好的語法可加快搜尋速度

謝謝!

Rept.rar (525.45 KB)

樓主熱帖

n7822123

　暱稱: 阿龍

中學生 Rank: 2

帖子: 406
主題: 8
精華: 0
積分: 453
點名: 0
作業系統: WINDOWS 7
軟體版本: 2007
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2015-2-7
最後登錄: 2021-7-31

2^#

發表於 2018-8-30 02:55 | 只看該作者

回復 1# Qin

Rept+1.rar (446.33 KB)

快一些些(程序test2)，字典物件也就這樣了，期待有更好的寫法

程序test1=原程序+計時器

話說...."笭葩" 是什麼意思?

Private Sub test2()
t1 = Timer
Application.ScreenUpdating = False
Dim arr As Range, brr()
Dim i As Long, Rn As Long
Dim Dict As Object
On Error Resume Next
Set Dict = CreateObject("scripting.dictionary")
With ActiveSheet
Set arr = Intersect(.UsedRange, .Columns(3))
Rn = arr.Cells.Count
ReDim brr(1 To Rn)
For i = 1 To Rn
Dict(arr(i).Value) = Dict(arr(i).Value) + 1
Next i
For i = 1 To Rn
If Dict(arr(i).Value) <> 1 Then brr(i) = "重覆"
Next i
.Columns(2) = ""
.Range("b1").Resize(Rn, 1) = Application.Transpose(brr)
End With
Application.ScreenUpdating = True
MsgBox "test2共耗時" & Round(Timer - t1, 3) & "秒"
End Sub

複製代碼

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2842
主題: 10
精華: 0
積分: 2898
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2025-4-26

3^#

發表於 2018-8-30 10:24 | 只看該作者

Sub test_01()
Dim Arr, xD, i&, T$, U&, TM
TM = Timer
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([C2], Cells(Rows.Count, 3).End(3))
For i = 1 To UBound(Arr)
T = Arr(i, 1): U = xD(T): Arr(i, 1) = ""
If U > 0 Then Arr(U, 1) = "重覆": xD(T) = -1: U = -1
If U < 0 Then Arr(i, 1) = "重覆"
If U = 0 Then xD(T) = i
Next i
[B2].Resize(UBound(Arr)) = Arr
MsgBox Timer - TM
End Sub

五萬多筆, 約一秒內可完成~~

TOP

a5007185

　暱稱: 阿佐
　頭銜: 上班無聊打怪去

中學生 Rank: 2

帖子: 108
主題: 1
精華: 0
積分: 113
點名: 0
作業系統: Win 10
軟體版本: Office 2016
閱讀權限: 20
性別: 男
來自: 臺灣
註冊時間: 2017-9-7
最後登錄: 2019-2-27

論壇榮譽勳章論壇贊助勳章

4^#

發表於 2018-8-30 11:32 | 只看該作者

回復 3# 准提部林

我原本還傻傻地想說用 for迴圈加上countif
然後就當機了 XD

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2842
主題: 10
精華: 0
積分: 2898
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2025-4-26

5^#

發表於 2018-8-30 11:45 | 只看該作者

回復 4# a5007185

如果用VBA, 非不得已才去用函數, 儘量避免,
一般的公式解, COUNTIF也是特別慢, 資料一多, 準卡檔!

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2842
主題: 10
精華: 0
積分: 2898
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2025-4-26

6^#

發表於 2018-8-30 11:52 | 只看該作者

Sub test_02()
Dim Arr, Brr, xD, i&, TM
TM = Timer
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([C2], Cells(Rows.Count, 3).End(3))
ReDim Brr(1 To UBound(Arr), 0)
For i = 1 To UBound(Arr)
xD(Arr(i, 1) & "") = xD(Arr(i, 1) & "") + 1
Next i
For i = 1 To UBound(Arr)
If xD(Arr(i, 1) & "") > 1 Then Brr(i, 0) = "重覆"
Next
[B2].Resize(UBound(Arr)) = Brr
MsgBox Timer - TM
End Sub

這是基本套路, 用了兩個迴圈, 慢一些些~~
xD(Arr(i, 1) & "") 加 "" 是為防止[純數字]在數值格式與文字格式不同而產生差異!

TOP

Qin

中學生 Rank: 2

帖子: 207
主題: 61
精華: 0
積分: 270
點名: 0
作業系統: Vista
軟體版本: office2003
閱讀權限: 20
性別: 女
註冊時間: 2011-3-20
最後登錄: 2023-6-25

7^#

發表於 2018-8-30 20:55 | 只看該作者

回復 3# 准提部林

謝謝准大

跟之前的速度相比 ,現在好像坐上高鐵...

TOP

n7822123

　暱稱: 阿龍

中學生 Rank: 2

帖子: 406
主題: 8
精華: 0
積分: 453
點名: 0
作業系統: WINDOWS 7
軟體版本: 2007
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2015-2-7
最後登錄: 2021-7-31

8^#

發表於 2018-8-31 01:11 | 只看該作者

回復 6# 准提部林

準大太厲害啦，原來字典物件輸入的key是字串型態的話，速度可以提昇那麼多!!!

如果是非字串，速度整個慢下來!

另外用字典記錄上一個重覆的列號並且一起輸入"重覆"的寫法也很棒，可以只用一個迴圈

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

9^#

發表於 2018-8-31 08:39 | 只看該作者

本帖最後由 GBKEE 於 2018-8-31 09:12 編輯

回復 7# Qin
輔助欄+排序+IF公式

Sub Ex()
Dim xTime As Date
xTime = Time
Debug.Print Time
With Range("C2:C" & [C2].End(xlDown).Row) '資料欄
.Offset(, 1) = "=ROW()" '輔助欄
.CurrentRegion.Sort KEY1:=.Cells(1), Header:=xlYes '排序以資料欄為主鍵
.Offset(, -1) = "=IF(OR(RC[1]=R[-1]C[1], RC[1]=R[1]C[1]),""重複"","""")" '要顯示重複的欄寫上公式
.CurrentRegion.Value = .CurrentRegion.Value '將公式轉為數值
.CurrentRegion.Sort KEY1:=.Cells(1, 2), Header:=xlYes '排序以輔助欄為主鍵 :還原資料欄原有的排列
.Offset(, 1) = "" '清除輔助欄
End With
Debug.Print Time
MsgBox Application.Text(Time - xTime, ["計時 ss 秒"])
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

TOP

千暉尋

中學生 Rank: 2

帖子: 36
主題: 7
精華: 0
積分: 77
點名: 0
作業系統: WIN7
軟體版本: MICROSOFT
閱讀權限: 20
註冊時間: 2015-6-7
最後登錄: 2024-9-22

論壇榮譽勳章論壇贊助勳章

10^#

發表於 2018-9-27 15:07 | 只看該作者

回復准提部林

準大太厲害啦，原來字典物件輸入的key是字串型態的話，速度可以提昇那麼多!!!

如果 ...
n7822123 發表於 2018-8-31 01:11

3個語法,可看懂2個,唯獨准大的第1個程式碼,我想了好久,針對以下語法
For i = 1 To UBound(Arr)
T = Arr(i, 1): U = xD(T): Arr(i, 1) = ""
If U > 0 Then Arr(U, 1) = "重覆": xD(T) = -1: U = -1
If U < 0 Then Arr(i, 1) = "重覆"
If U = 0 Then xD(T) = i
Next i
還是想不透為何如此就能判斷出重覆與否,那位大大可以幫忙解說一下嗎?

TOP