过程中断后重新运行过程，发现其中字典初始化后就保留了原值，remove都不起作用

hhjjpp · 发表于 2016-10-25 16:36

Sub lqxs()
Dim Arr, i&, j&, n&, d
Set d = CreateObject("Scripting.Dictionary")
'd.RemoveAll
Arr = [a1].CurrentRegion
Cells.Interior.ColorIndex = xlNone
For i = 1 To UBound(Arr)
'd.RemoveAll
'Set d = Nothing
If Not d.exists(Arr(i, 3)) Then
d(Arr(i, 3)) = n Mod 53 + 3
n = n + 1
End If
'd.RemoveAll
Next
For i = 1 To UBound(Arr)
If d.exists(Arr(i, 3)) Then
Cells(i, 3).Interior.ColorIndex = n
End If
Next
End Sub

复制代码

上面是一段再简单不过的代码，调试后中断字典赋值并退出；重新运行之后，发现首次执行到If Not d.exists(Arr(i, 3)) Then时，字典突然出现了原值。
上述几个d.RemoveAll和Set d = Nothing就是调试不正常时清除字典所用。但反复运行总发现到If Not d.exists(Arr(i, 3)) 字典没赋值之前突然有值，即使退出excel，重新打开也是如此。尤其是执行代码d.RemoveAll之后只清除第1个key，死活奈何不了”禤培辉“这个死硬分子！
以前调试也遇过字典无故复活的情况，不过重启excel就好，这回不知怎么的，另外换台电脑字典还是有那个”禤培辉“！
请各位指点一二！

补充内容 (2016-12-12 14:04):
已解决

hhjjpp · 发表于 2016-10-25 16:39

前面循环是根据不同姓名赋予字典item以各异的colorindex值

hhjjpp · 发表于 2016-10-25 16:43

代码第4、8、9和14行就是调试字典异常时，随时去掉单引号执行清理任务，发现“郭淑敏”可清除，但那个”禤培辉“总是无可奈何！
难道程序运行完之后，字典d会保留残值到下次运行。可我每次打开，在第10行之前，d.count都是0，就到了那个If Not d.exists(Arr(i, 3))就开始死灰复燃！

hhjjpp · 发表于 2016-10-25 16:46

现在突然好了，但我还是想知道这是怎么回事？以免以后再遇到误事！

hhjjpp · 发表于 2016-10-25 16:51

本帖最后由 hhjjpp 于 2016-10-25 16:52 编辑

可是好景不长，到了i=3，arr(i,3)是陈闽海，刚才左边的item都没有陈闽海，到If Not d.exists(Arr(i, 3))就出然有了陈闽海，我还没来得及赋值呀，怎么d.exists(Arr(i, 3))就成了true，直接跳出if语句（第10行直接跳到第13行，颜色值都没来得及赋呀！）？

hhjjpp · 发表于 2016-10-25 17:03

本帖最后由 hhjjpp 于 2016-10-25 17:10 编辑

然而好景不长、美好不再！尽管由于工作表姓名栏有合并单元格，造成arr时有空值；但我改了if条件，可还是如此死硬：

Sub lqxs()
Dim Arr, i&, j&, n&, d
Set d = CreateObject("Scripting.Dictionary")
'd.RemoveAll
Arr = [a1].CurrentRegion
Cells.Interior.ColorIndex = xlNone
For i = 1 To UBound(Arr)
'd.RemoveAll
'Set d = Nothing
If Not d.exists(Arr(i, 3)) And Len(Arr(i, 3)) Then
d(Arr(i, 3)) = n Mod 53 + 3
n = n + 1
End If
'd.RemoveAll
Next
For i = 1 To UBound(Arr)
If d.exists(Arr(i, 3)) Then
Cells(i, 3).Interior.ColorIndex = n
End If
Next
End Sub

复制代码

hhjjpp · 发表于 2016-10-25 17:04

数据源也在工作表用len(c1)拖放过，并未发现不可见字符！

hhjjpp · 发表于 2016-10-25 17:13

字典异常时，执行d.removeall调试代码居然都有清除不尽的情况

doitbest · 发表于 2016-10-25 21:13

这个似乎没有问题
Sub lqxs()
Dim Arr, i&, j&, n&, d
Set d = CreateObject("Scripting.Dictionary")
Arr = [a1].CurrentRegion
Range("a1").CurrentRegion.Interior.ColorIndex = xlNone
For i = 1 To UBound(Arr)
If Not d.exists(Arr(i, 3)) And Arr(i, 3) <> "" Then
   d(Arr(i, 3)) = n Mod 53 + 3
   n = n + 1
End If
Next
For i = 1 To UBound(Arr)
If d.exists(Arr(i, 3)) Then
   Cells(i, 3).MergeArea.Interior.ColorIndex = d(Arr(i, 3))
End If
Next
End Sub

hhjjpp · 发表于 2016-10-26 08:18

本帖最后由 hhjjpp 于 2016-10-26 08:20 编辑

doitbest 发表于 2016-10-25 21:13
这个似乎没有问题
Sub lqxs()
Dim Arr, i&, j&, n&, d

Sub lqxs()
Dim Arr, i&, j&, n&, d
Set d = CreateObject("Scripting.Dictionary")
Arr = [a1].CurrentRegion
Cells.Interior.ColorIndex = xlNone
For i = 1 To UBound(Arr)
If Not d.exists(Arr(i, 3)) And Len(Arr(i, 3)) Then
d(Arr(i, 3)) = n Mod 53 + 3
n = n + 1
End If
Next
For i = 1 To UBound(Arr)
If d.exists(Arr(i, 3)) Then
Cells(i, 3).Interior.ColorIndex = d(Arr(i, 3))
Cells(i, 3).Font.ColorIndex = 33 - d(Arr(i, 3)) Mod 53 '保证负数取圈邻末数
End If
Next
End Sub

复制代码

楼上附件原在xp+03，回家拿到win7+03居然没问题；但这个原文件xl-h.xls今早一打开，到第3位在字典未赋值之前“陈闽海”就已存在key值，监视窗口d(Arr(i, 3))为空值，然后执行14行的d.RemoveAll，居然杀不死陈闽海
昨晚的附件见下，拿回xp+03打开执行，一切正常！与楼上附件比只删除了调试用的代码，加了一行给字体添色的代码而已！

		自动登录	找回密码
密码			免费注册

[求助] 过程中断后重新运行过程，发现其中字典初始化后就保留了原值，remove都不起作用