作者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/cn.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