Board logo

标题: [问题求助] [已解决]请问纯 VBS 数组排序算法怎么写?(要求纯 VBS 无组件) [打印本页]

作者: yu2n    时间: 2015-1-15 22:53     标题: [已解决]请问纯 VBS 数组排序算法怎么写?(要求纯 VBS 无组件)

本帖最后由 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:如果支持中文拼音排序就更好了 ...
作者: CrLf    时间: 2015-1-16 00:08

写了个冒泡的
话说和不用 str2hex 的结果没区别嘛...
不知道这样是不是按 Local 顺序排列的
  1. arr = Array("ACE_OVER", "AC-012", "-1","@fas" ,"520", "淡淡的忧伤", "098", "小小")
  2. For i=0 To UBound(arr)
  3. arr(i) = str2hex(arr(i))
  4. Next
  5. For i=1 To UBound(arr)
  6. For j=i To 1 Step -1
  7. If CStr(arr(j))<CStr(arr(j-1)) Then
  8. tmp = arr(j)
  9. arr(j) = arr(j-1)
  10. arr(j-1) = tmp
  11. End If
  12. Next
  13. Next
  14. For i=0 To UBound(arr)
  15. WScript.Echo (arr(i))
  16. WScript.Echo hex2str(arr(i))
  17. Next
  18. Function str2hex(str)
  19. Dim i,char,arr()
  20. ReDim arr(Len(str))
  21. For i=1 To Len(str)
  22. char = Mid(str,i,1)
  23. If Asc(char)<0 Then
  24. arr(i-1) = char
  25. Else
  26. arr(i-1) = "\x" & Right("0" & Hex(Asc(char)),2)
  27. End If
  28. Next
  29. str2hex = Join(arr,"")
  30. End Function
  31. Function hex2str(hexstr)
  32. Dim i
  33. For i=0 To 127
  34. If i <> 92 Then
  35. hexstr = Replace(hexstr,"\x" & Right("0" & Hex(i),2),Chr(i))
  36. End If
  37. Next
  38. hex2str = Replace(hexstr,"\x5c","\")
  39. End Function
复制代码

作者: CrLf    时间: 2015-1-16 00:09

如果不涉及字节操作,还是 js 好用啊
作者: Demon    时间: 2015-1-16 00:14

我是来围观的
作者: yu2n    时间: 2015-1-16 00:30

放上我的解 ... 嗯 ... 支持64个中英文字符,超过64的,按64个算:
  1. arr = Array("ACE_OVER" & String(999, "_"), "AC-012", "520", "淡淡的忧伤", "098", "小小")
  2. arr2 = arr
  3. For i = 0 To UBound(arr)
  4.     For j = i + 1 To UBound(arr)
  5.         If Summary(arr, i) > Summary(arr, j) Then
  6.           t = arr(i)
  7.           arr(i) = arr(j)
  8.           arr(j) = t
  9.         End If
  10.     Next
  11. Next
  12. WScript.Echo Join(arr2, ", ") & vbCrLf & vbCrLf & "=>" & vbCrLf & vbCrLf & Join(arr, ", ")
  13. Function Summary(ByVal arr, ByVal nIndex)
  14.     nMaxLen = 64
  15.     nLen = Len(arr(nIndex))
  16.     If nLen > nMaxLen Then nLen = nMaxLen
  17.     For n = 1 To nLen
  18.       nCount = nCount + Abs(AscW(Mid(arr(nIndex), n, 1))) * (65535 ^ (nMaxLen - n))
  19.     Next
  20.     Summary = nCount
  21. End Function
复制代码

作者: CrLf    时间: 2015-1-16 01:10

回复 5# yu2n


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

作者: yu2n    时间: 2015-1-16 01:40

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


简单测试了下,原来只用CStr()就可以比较大小,默认就是AcsW的排序了,看来是我想多了...
作者: Demon    时间: 2015-1-16 12:40

沼跃鱼早已看穿了一切,却看不懂你们的算法。
作者: yu2n    时间: 2015-1-16 19:24

回复 8# Demon

  1. 排序算法:冒泡排序
  2. 排序条件:字符串逐个字符按字符码(AscW函数)升序排序
  3. 方法1: CStr(字符串) 直接比较大小
  4. 方法2: 字符串 -> 拆分单个字符
  5.       -> 转16进制(Hex)表示
  6.       -> 合并Hex字符串
  7.       -> CStr(Hex字符串) 比较大小
  8. 方法3: 字符串 -> 拆分单个字符
  9.       -> 计算单个字符的“权重”:AscW(Chr_) * 65536 ^ (最大字符串长度 - 当前字符位置)
  10.       -> 累加单个字符的“权重”
  11.       -> 比较累加后的字符串“权重”大小
  12. Ps:
  13. 方法1 使用 CStr() 直接达成排序条件,推荐使用。
  14.       本人因为之前测试方法有误,测试失败就没采用 ... 后来测试CStr()可用。
  15. 方法2 应该可以在比较特殊的情况下使用。
  16. 方法3 “权重”数值太大,超范围会失效。不建议使用。
复制代码

作者: yu2n    时间: 2015-1-21 06:50

贴个代码留念~
  1. ' 『表格字符串』指定列名、列号排序  by yu2n
  2. ' 指定列名(usr)排序:
  3. ' sn,usr,pwd
  4. ' 01,CCC,D00
  5. ' 02,BBB,E11
  6. ' 03,AAA,F22
  7. ' =>
  8. ' sn,usr,pwd
  9. ' 03,AAA,F22
  10. ' 02,BBB,E11
  11. ' 01,CCC,D00
  12. ' 指定列序号(2)排序:
  13. ' 01,CCC,D00
  14. ' 02,BBB,E11
  15. ' 03,AAA,F22
  16. ' =>
  17. ' 03,AAA,F22
  18. ' 02,BBB,E11
  19. ' 01,CCC,D00
  20. Demo
  21. Sub Demo()
  22.   sField = "sn,usr,pwd"
  23.   sContent = "01,CCC,D00" & vbCrLf _
  24.           & "02,BBB,E11" & vbCrLf _
  25.           & "03,AAA,F22"
  26.   ' 指定列名排序
  27.   sTable = sField & vbCrLf & sContent
  28.   WScript.Echo "指定列名(usr)排序:" & vbCrLf & sTable & vbCrLf & "=>" _
  29.     & vbCrLf & SortTableString(sTable, "usr", ",") & vbCrLf
  30.   ' 指定列序号排序
  31.   sTable = sContent
  32.   WScript.Echo "指定列序号(2)排序:" & vbCrLf & sTable & vbCrLf & "=>" _
  33.     & vbCrLf & SortTableString(sTable, 2, ",") & vbCrLf
  34. End Sub
  35. Function SortTableString(ByVal sTable, ByVal sField, ByVal sFlag)
  36.   ' Format String
  37.   sTable = Trim(sTable)
  38.   If Left(sTable, 2) = vbCrLf Then sTable = Right(sTable, Len(sTable) - 2)
  39.   If Right(sTable, 2) = vbCrLf Then sTable = Left(sTable, Len(sTable) - 2)
  40.   If InStr(sTable, vbCrLf) < 1 Or InStr(sTable, sFlag) < 1 Then Exit Function
  41.   ' init ...
  42.   Dim arr(), arrRows, arrCols, nRowStart
  43.   arrRows = Split(sTable, vbCrLf)
  44.   If UBound(arrRows) = 0 Then Exit Function
  45.   nRowStart = 0
  46.   nRows = UBound(arrRows)
  47.   nCols = UBound(Split(arrRows(0), sFlag))
  48.   ReDim Preserve arr(nCols, nRows)
  49.   For nRow = 0 To nRows
  50.     arrCols = Split(arrRows(nRow), sFlag)
  51.     For nCol = 0 To nCols
  52.       ' Set Table
  53.       arr(nCol, nRow) = arrCols(nCol)
  54.       ' Get nField Index
  55.       If nRow = 0 Then
  56.         If sField = nCol + 1 Then nField = nCol
  57.         If sField = arrCols(nCol) Then nField = nCol: nRowStart = 1
  58.       End If
  59.     Next
  60.   Next
  61.   ' Sort by Field_Index/Field_Name
  62.   Dim i, j, tmp
  63.   For i = nRowStart To nRows
  64.     For j = i + 1 To nRows
  65.       If CStr(arr(nField, i)) > CStr(arr(nField, j)) Then
  66.         tmp = arrRows(i)
  67.         arrRows(i) = arrRows(j)
  68.         arrRows(j) = tmp
  69.       End If
  70.     Next
  71.   Next
  72.   ' Output
  73.   SortTableString = Join(arrRows, vbCrLf)
  74. End Function
复制代码





欢迎光临 批处理之家 (http://www.bathome.net/) Powered by Discuz! 7.2