Scripting.Dictionary字典对象按键名Key进行冒泡排序

!本文可能 超过1年没有更新,今后内容也许不会被维护或者支持,部分内容可能具有时效性,涉及技术细节或者软件使用方面,本人不保证相应的兼容和可操作性。

最近加班比较多,代码写得有点乱,结果今天出现了个低级错误,原本想把Scripting.Dictionary对象的Item按照指定fnCompare函数作用的Key字段排序,原本以为很简单,于是就拿了个普通的冒泡排序就用了起来,结果问题就出现了,这里有问题的代码如下:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Option Explicit
 
Function fnCompare(key1, key2)
 If CInt(key1)>CInt(key2) Then
   fnCompare = 1
 ElseIf CInt(key1)<CInt(key2) Then
  fnCompare = -1
 Else
  fnCompare = 0
 End If
End Function
 
Function Sort(dict)
  Dim i,j, temp
  Dim keys,items
 
  For i = 0 To  dict.Count-1
    For j = i+1 To dict.Count - 1
	  keys = dict.Keys
	  items = dict.Items
      If fnCompare(keys(i), keys(j))>0 Then
        ' 交换Item项目
        temp = items(i)
        dict.Item(keys(i)) = items(j)
        dict.Item(keys(j)) = temp        
        ' 交换Key键名
        temp = keys(i)
        dict.Key(keys(i)) = keys(j)
        dict.Key(keys(j)) = temp
      End If
    Next
  Next
End Function
 
Sub VBMain()
  Dim dict
  Set dict = WSH.CreateObject("Scripting.Dictionary")
    dict.Add "2", "a"
    dict.Add "8", "b"
    dict.Add "1", "c"
    Sort dict
  Set dict = Nothing
End Sub
 
Call VBMain()

貌似这样看上去很正常,算法没有什么问题,交换Item后交换Key,貌似也没有问题,但是偏偏运行时出现了下面这个错误框。

Scripting.Dictionary 排序错误.png

“此键已与该集合的一个元素关联”这个错误意思是主键重复。回想一下刚才的算法,我们这里关注一下key的交换,键Key能简简单单交换吗?对于这种赋值形式的交换肯定是不行的,因为这样在操作过程中必定会产生重复的Key。而Key的唯一性绝对不能容忍这种情况存在,所以这样排序明显是不行的。

如果说冒泡的算法不变,有什么办法避免呢?我简单的想到了一个笨方法:首先将Keys赋值到数组,并将数组进行冒泡排序,然后根据原先的Dictionary对象索引到Item,最后新建立Dictionary对象,兜了一个大圈子,哎,先临时解决一下吧,具体代码如下:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
Option Explicit
 
Function fnCompare(key1, key2)
 If CInt(key1)>CInt(key2) Then
   fnCompare = 1
 ElseIf CInt(key1)<CInt(key2) Then
  fnCompare = -1
 Else
  fnCompare = 0
 End If
End Function
 
Function Sort(dict)
  Dim i,j, temp
  Dim keys,items
  Dim t ' 临时备份字典
  Set t = WSH.CreateObject("Scripting.Dictionary")
 
  keys = dict.Keys
  items = dict.Items
 
  ' 下面复制原字典到备份字典中
  For i = 0 To  dict.Count-1
    t.Add keys(i),items(i)
  Next
 
  ' 下面交换键key数组
  For i = 0 To  dict.Count-1
    For j = i+1 To dict.Count - 1
      If fnCompare(keys(i), keys(j))>0 Then
        temp = keys(i)
        keys(i) = keys(j)
        keys(j) = temp
      End If
    Next
  Next
 
  dict.RemoveAll ' 清除原数组
 
  ' 读取已经排好序的key数组
  ' 并添加到清空后的目标字典中
  For i = 0 To UBound(keys)
   dict.Add keys(i), t.Item(keys(i))
  Next
 
  ' 销毁备份字典
  t.RemoveAll
  Set t = Nothing
End Function
 
Sub VBMain()
  Dim dict
  Set dict = WSH.CreateObject("Scripting.Dictionary")
    dict.Add "2", "a"
    dict.Add "8", "b"
    dict.Add "1", "c"
    Sort dict
  Set dict = Nothing
End Sub
 
Call VBMain()

这个事情说明看问题还是不能想当然的看表面哎!

若无特别说明,本网站文章均为原创,原则上这些文章不允许转载,但是如果阁下是出于研究学习目的可以转载到阁下的个人博客或者主页,转载遵循创作共同性“署名-非商业性使用-相同方式共享”原则,请转载时注明作者出处谢绝商业性、非署名、采集站、垃圾站或者纯粹为了流量的转载。谢谢合作!

请稍后...

发表评论

电子邮件地址不会被公开。 必填项已用*标注