作者sworder12 (sworder)
看板Office
標題[算表] vba dictionary 遇到空值如何跳過
時間Thu Feb 21 17:48:00 2019
軟體:excel
版本:2016
hi,小弟前兩天有發問如何用access 顯示重複次數，用來管理歌曲清單的(兩萬多筆)
當初是因為excel 函數(count if) 計算太吃資源，爬文可以用access 來處理
現在又覺得access 不是很直覺，因為不太會用...
反正現在試出一個方法就是用vba來檢查是否重複（如圖），跑起來也是很快速
https://imgur.com/EBq3gWS.png
現在一個問題就是，我的語法裡面，如果遇到空白的值，也會返回 "重複" 結果
程式碼如下，不知道該怎麼修改...
Sub 按鈕5_Click()
Dim Arr, xD, i&, T$, U&, TM
TM = Timer
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([K2], Cells(Rows.Count, 11).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
[I2].Resize(UBound(Arr)) = Arr
MsgBox Timer - TM
End Sub
--
※ 發信站: 批踢踢實業坊(ptt.cc), 來自: 114.221.186.225
※ 文章網址: https://webptt.com/m.aspx?n=bbs/Office/M.1550742493.A.882.html
1F：→ soyoso: for下面加上if arr(i,1)<>"" then，next上面加上end if 02/21 18:14
2F：→ soyoso: 或是於U=0後面加上 and T<>"" 02/21 18:53
謝謝soyoso大神幫忙解決，我現在才發現我昨天寫錯了..但空白值這測試應該沒問題
現在想重新發問...圖片中有詳細說明...感謝您的幫忙...
https://i.imgur.com/QEtFrAx.png
程式碼一樣是上面那個下去改應該就可以了吧？
※ 編輯: sworder12 (114.221.186.225), 02/22/2019 19:40:37
※ 編輯: sworder12 (114.221.186.225), 02/22/2019 19:42:28
3F：→ soyoso: 可以該巨集下去修改，只需加上迴圈於k欄，將有資料的值先 02/22 21:25
4F：→ soyoso: 加入於變數xD內，值指定為0；該迴圈寫於原本for...next的 02/22 21:26
5F：→ soyoso: 上方 02/22 21:26
6F：→ soyoso: 另外arr原指定k2至k欄下方最後一值有值的範圍，改為a2至a 02/22 21:27
7F：→ soyoso: 欄下方最後一個有值的儲存格 ^^個 ^^^^儲存格 02/22 21:28
8F：→ soyoso: 於if u>0上方加上if xD.exists(T) then，並將u=XD(T)移到 02/22 21:41
9F：→ soyoso: 判斷內，在next i上方加上end if 02/22 21:41
小弟資質駑頓...試了幾次和爬文找解釋還是寫不出來...
目前寫到這樣...感覺卡在K欄迴圈不懂怎麼寫入...
Sub 按鈕5_Click()
Dim Arr, xD, i&, T$, U&, TM
Dim Arr, Brr, xD, i&, T$, U&, TM
TM = Timer
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([A2], Cells(Rows.Count, 1).End(3)) '改為a2至a欄下方最後一個有值的儲存格
Brr = Range([K2], Cells(Rows.Count, 11).End(3))
'加上迴圈於k欄，將有資料的值先加入於變數xD內，值指定為0；該迴圈寫於原本for...next的上方
----這邊寫不出來----
For i = 1 To UBound(Arr)
T = Arr(i, 1): Arr(i, 1) = ""
if xD.exists(T) then U = xD(T)
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 And T <> ""
end if
Next i
[I2].Resize(UBound(Arr)) = Arr
MsgBox Timer - TM
End Sub
※ 編輯: sworder12 (114.221.186.225), 02/22/2019 23:37:54
※ 編輯: sworder12 (114.221.186.225), 02/22/2019 23:38:45
10F：→ soyoso: 如是先將範圍置於變數Brr的話，可以下方for i = 1 to 02/23 07:21
11F：→ soyoso: ubound(brr) 02/23 07:21
12F：→ soyoso: t=brr(i,1) 02/23 07:22
13F：→ soyoso: if t<>"" then xd(t) = 0 02/23 07:22
14F：→ soyoso: next i 02/23 07:23
15F：→ soyoso: 的方式來寫 02/23 07:23
16F：→ soyoso: 如不置於Brr內的話，迴圈終止值也可以range.end.row 02/23 07:25
17F：→ soyoso: 再判斷range是否為空白儲存格，或先置於t內判斷 02/23 07:26
18F：→ soyoso: 也可for each..next迴圈於range.specialcells以k欄範圍內 02/23 07:27
19F：→ soyoso: 有值的儲存格 02/23 07:28
20F：→ soyoso: 另外回文變數重複宣告，if有配合endif，u=xd(t)需移置下一 02/23 07:31
21F：→ soyoso: 行 02/23 07:32
22F：→ soyoso: xd(t)=i and t <>""方面，判斷的話，應是if u=0 and t<>"" 02/23 07:34
感謝大神幫忙，測試可用！！
最終程式碼如下在此貼上，有需求的人可以看看，最後再次感謝大神幫忙！
Sub 按鈕5_Click()
Dim Arr, Brr, xD, i&, T$, U&, TM
TM = Timer
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([A2], Cells(Rows.Count, 1).End(3))
Brr = Range([K2], Cells(Rows.Count, 11).End(3))
For i = 1 To UBound(Brr)
T = Brr(i, 1)
If T <> "" Then xD(T) = 0
Next i
For i = 1 To UBound(Arr)
T = Arr(i, 1): Arr(i, 1) = ""
If xD.exists(T) Then
U = xD(T)
If U > 0 Then Arr(U, 1) = "重覆": xD(T) = -1: U = -1
If U < 0 Then Arr(i, 1) = "重覆"
If U = 0 And T <> "" Then xD(T) = i
End If
Next i
[I2].Resize(UBound(Arr)) = Arr
MsgBox Timer - TM
End Sub
※ 編輯: sworder12 (117.60.68.75), 02/23/2019 09:02:43