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

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

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，貌似也没有问题，但是偏偏运行时出现了下面这个错误框。

—————————
Windows 脚本宿主
—————————
脚本: D:\Sort.vbs
行: 28
字符: 9
错误: 此键已与该集合的一个元素关联
代码: 800A01C9
源: Microsoft VBScript 运行时错误

—————————
确定
—————————

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

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

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()

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

原文链接：http://wangye.org/blog/archives/127/

随机文章:

1. Windows 7关闭共享后怎样去掉图标上的小锁
2. VBS调用WMI搜索文件
3. 用Data URI Scheme嵌入内联图像
4. OpenWrt使用adbyby过滤广告
5. 硬盘整数分区FAT32/NTFS方法

这篇文章发布于 2012年02月15日，星期三，22:35，归类于 复制粘贴。 您可以跟踪这篇文章的评论通过 RSS 2.0 feed。 您可以留下评论，或者从您的站点trackback。