设为首页收藏本站
切换到宽版

 找回密码
 注册
搜索
批处理之家»论坛 › 其他脚本区 › VBS求助&讨论 › [已解决]请问纯 VBS 数组排序算法怎么写？（要求纯 VBS ...
[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发新帖
查看: 24676|回复: 9

[问题求助] [已解决]请问纯 VBS 数组排序算法怎么写？（要求纯 VBS 无组件）

[复制链接]
yu2n
发表于 2015-1-15 22:53:21 | 显示全部楼层 |阅读模式
本帖最后由 yu2n 于 2015-1-16 01:34 编辑

请问纯 VBS 数组排序算法怎么写？（要求纯 VBS 无组件）

如何将数组中的字符串按从左到右、AscW()的大小升序排列？
排序前：
  1. Array("ACE_OVER", "AC-012", "520", "淡淡的忧伤", "098", "小小")
复制代码
排序后
  1. Array("098", "520", "AC-012", "ACE_OVER", "小小", "淡淡的忧伤")
复制代码
补充1：字符串暂限定长度为 256 。
补充2：如果支持中文拼音排序就更好了 ...

评分

参与人数 1PB +2 收起 理由
Batcher + 2 感谢给帖子标题标注[已解决]字样

查看全部评分

回复

举报

CrLf
发表于 2015-1-16 00:08:29 | 显示全部楼层
写了个冒泡的
话说和不用 str2hex 的结果没区别嘛...
不知道这样是不是按 Local 顺序排列的
  1. arr = Array("ACE_OVER", "AC-012", "-1","@fas" ,"520", "淡淡的忧伤", "098", "小小")

  3. For i=0 To UBound(arr)
  4.         arr(i) = str2hex(arr(i))
  5. Next

  7. For i=1 To UBound(arr)
  8.         For j=i To 1 Step -1
  9.                 If CStr(arr(j))<CStr(arr(j-1)) Then
  10.                         tmp = arr(j)
  11.                         arr(j) = arr(j-1)
  12.                         arr(j-1) = tmp
  13.                 End If
  14.         Next
  15. Next

  17. For i=0 To UBound(arr)
  18.         WScript.Echo (arr(i))
  19.         WScript.Echo hex2str(arr(i))
  20. Next

  22. Function str2hex(str)
  23.         Dim i,char,arr()
  24.         ReDim arr(Len(str))
  25.         For i=1 To Len(str)
  26.                 char = Mid(str,i,1)
  27.                 If Asc(char)<0 Then
  28.                         arr(i-1) = char
  29.                 Else
  30.                         arr(i-1) = "\x" & Right("0" & Hex(Asc(char)),2)
  31.                 End If
  32.         Next
  33.        
  34.         str2hex = Join(arr,"")       
  35. End Function

  37. Function hex2str(hexstr)
  38.         Dim i
  39.         For i=0 To 127
  40.                 If i <> 92 Then
  41.                         hexstr = Replace(hexstr,"\x" & Right("0" & Hex(i),2),Chr(i))
  42.                 End If
  43.         Next
  44.        
  45.         hex2str = Replace(hexstr,"\x5c","")
  46. End Function
复制代码

评分

参与人数 1技术 +1 收起 理由
yu2n + 1 乐于助人

查看全部评分

回复

举报

CrLf
发表于 2015-1-16 00:09:37 | 显示全部楼层
如果不涉及字节操作，还是 js 好用啊
回复

举报

Demon
发表于 2015-1-16 00:14:35 | 显示全部楼层
我是来围观的
回复

举报

yu2n
 楼主| 发表于 2015-1-16 00:30:10 | 显示全部楼层
放上我的解 ... 嗯 ... 支持64个中英文字符，超过64的，按64个算：
  1. arr = Array("ACE_OVER" & String(999, "_"), "AC-012", "520", "淡淡的忧伤", "098", "小小")
  2. arr2 = arr

  4. For i = 0 To UBound(arr)
  5.     For j = i + 1 To UBound(arr)
  6.         If Summary(arr, i) > Summary(arr, j) Then
  7.           t = arr(i)
  8.           arr(i) = arr(j)
  9.           arr(j) = t
  10.         End If
  11.     Next
  12. Next

  14. WScript.Echo Join(arr2, ", ") & vbCrLf & vbCrLf & "=>" & vbCrLf & vbCrLf & Join(arr, ", ")

  16. Function Summary(ByVal arr, ByVal nIndex)
  17.     nMaxLen = 64
  18.     nLen = Len(arr(nIndex))
  19.     If nLen > nMaxLen Then nLen = nMaxLen
  20.     For n = 1 To nLen
  21.       nCount = nCount + Abs(AscW(Mid(arr(nIndex), n, 1))) * (65535 ^ (nMaxLen - n))
  22.     Next
  23.     Summary = nCount
  24. End Function
复制代码
回复

举报

CrLf
发表于 2015-1-16 01:10:53 | 显示全部楼层
回复 5# yu2n


    科学计数法不靠谱吧，受精度限制，只有头几个字是准的，后面就只保留位数了，给个反例：
  1. arr = Array("ACE_OVER" & String(17, "_") & "AAA", "ACE_OVER" & String(20, "_"),"ACE_OVER" & String(17, "_") & "AAA")
复制代码

评分

参与人数 1技术 +1 收起 理由
yu2n + 1 多谢指点。

查看全部评分

回复

举报

yu2n
 楼主| 发表于 2015-1-16 01:40:43 | 显示全部楼层
本帖最后由 yu2n 于 2015-1-16 01:41 编辑
写了个冒泡的
话说和不用 str2hex 的结果没区别嘛...
不知道这样是不是按 Local 顺序排列的
CrLf 发表于 2015-1-16 00:08


简单测试了下，原来只用CStr()就可以比较大小，默认就是AcsW的排序了，看来是我想多了...
回复

举报

Demon
发表于 2015-1-16 12:40:14 | 显示全部楼层
沼跃鱼早已看穿了一切，却看不懂你们的算法。
回复

举报

yu2n
 楼主| 发表于 2015-1-16 19:24:40 | 显示全部楼层
回复 8# Demon

  1. 排序算法：冒泡排序
  2. 排序条件：字符串逐个字符按字符码(AscW函数)升序排序

  4. 方法1: CStr(字符串) 直接比较大小

  6. 方法2: 字符串 -> 拆分单个字符
  7.       -> 转16进制(Hex)表示
  8.       -> 合并Hex字符串
  9.       -> CStr(Hex字符串) 比较大小

  11. 方法3: 字符串 -> 拆分单个字符
  12.       -> 计算单个字符的“权重”：AscW(Chr_) * 65536 ^ (最大字符串长度 - 当前字符位置)
  13.       -> 累加单个字符的“权重”
  14.       -> 比较累加后的字符串“权重”大小

  16. Ps:
  17. 方法1 使用 CStr() 直接达成排序条件，推荐使用。
  18.       本人因为之前测试方法有误，测试失败就没采用 ... 后来测试CStr()可用。

  20. 方法2 应该可以在比较特殊的情况下使用。

  22. 方法3 “权重”数值太大，超范围会失效。不建议使用。
复制代码
回复

举报

yu2n
 楼主| 发表于 2015-1-21 06:50:30 | 显示全部楼层
贴个代码留念~
  1. ' 『表格字符串』指定列名、列号排序  by yu2n

  3. ' 指定列名(usr)排序：
  4. ' sn,usr,pwd
  5. ' 01,CCC,D00
  6. ' 02,BBB,E11
  7. ' 03,AAA,F22
  8. ' =>
  9. ' sn,usr,pwd
  10. ' 03,AAA,F22
  11. ' 02,BBB,E11
  12. ' 01,CCC,D00

  14. ' 指定列序号(2)排序：
  15. ' 01,CCC,D00
  16. ' 02,BBB,E11
  17. ' 03,AAA,F22
  18. ' =>
  19. ' 03,AAA,F22
  20. ' 02,BBB,E11
  21. ' 01,CCC,D00

  23. Demo
  24. Sub Demo()
  25.   sField = "sn,usr,pwd"
  26.   sContent = "01,CCC,D00" & vbCrLf _
  27.           & "02,BBB,E11" & vbCrLf _
  28.           & "03,AAA,F22"
  29.   ' 指定列名排序
  30.   sTable = sField & vbCrLf & sContent
  31.   WScript.Echo "指定列名(usr)排序：" & vbCrLf & sTable & vbCrLf & "=>" _
  32.     & vbCrLf & SortTableString(sTable, "usr", ",") & vbCrLf
  33.   ' 指定列序号排序
  34.   sTable = sContent
  35.   WScript.Echo "指定列序号(2)排序：" & vbCrLf & sTable & vbCrLf & "=>" _
  36.     & vbCrLf & SortTableString(sTable, 2, ",") & vbCrLf
  37. End Sub

  39. Function SortTableString(ByVal sTable, ByVal sField, ByVal sFlag)
  40.   ' Format String
  41.   sTable = Trim(sTable)
  42.   If Left(sTable, 2) = vbCrLf Then sTable = Right(sTable, Len(sTable) - 2)
  43.   If Right(sTable, 2) = vbCrLf Then sTable = Left(sTable, Len(sTable) - 2)
  44.   If InStr(sTable, vbCrLf) < 1 Or InStr(sTable, sFlag) < 1 Then Exit Function
  45.   ' init ...
  46.   Dim arr(), arrRows, arrCols, nRowStart
  47.   arrRows = Split(sTable, vbCrLf)
  48.   If UBound(arrRows) = 0 Then Exit Function
  49.   nRowStart = 0
  50.   nRows = UBound(arrRows)
  51.   nCols = UBound(Split(arrRows(0), sFlag))
  52.   ReDim Preserve arr(nCols, nRows)
  53.   For nRow = 0 To nRows
  54.     arrCols = Split(arrRows(nRow), sFlag)
  55.     For nCol = 0 To nCols
  56.       ' Set Table
  57.       arr(nCol, nRow) = arrCols(nCol)
  58.       ' Get nField Index
  59.       If nRow = 0 Then
  60.         If sField = nCol + 1 Then nField = nCol
  61.         If sField = arrCols(nCol) Then nField = nCol: nRowStart = 1
  62.       End If
  63.     Next
  64.   Next
  65.   ' Sort by Field_Index/Field_Name
  66.   Dim i, j, tmp
  67.   For i = nRowStart To nRows
  68.     For j = i + 1 To nRows
  69.       If CStr(arr(nField, i)) > CStr(arr(nField, j)) Then
  70.         tmp = arrRows(i)
  71.         arrRows(i) = arrRows(j)
  72.         arrRows(j) = tmp
  73.       End If
  74.     Next
  75.   Next
  76.   ' Output
  77.   SortTableString = Join(arrRows, vbCrLf)
  78. End Function
复制代码
回复

举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

Archiver|手机版|小黑屋|批处理之家 ( 渝ICP备10000708号 )

GMT+8, 2026-3-17 14:49 , Processed in 0.022380 second(s), 11 queries , File On.

Powered by Discuz! X3.5

© 2001-2026 Discuz! Team.

快速回复 返回顶部 返回列表