标题: [问题求助] [已解决]请问纯 VBS 数组排序算法怎么写?(要求纯 VBS 无组件) [打印本页]
作者: yu2n 时间: 2015-1-15 22:53 标题: [已解决]请问纯 VBS 数组排序算法怎么写?(要求纯 VBS 无组件)
本帖最后由 yu2n 于 2015-1-16 01:34 编辑
请问纯 VBS 数组排序算法怎么写?(要求纯 VBS 无组件)
如何将数组中的字符串按从左到右、AscW()的大小升序排列?
排序前:- Array("ACE_OVER", "AC-012", "520", "淡淡的忧伤", "098", "小小")
复制代码
排序后- Array("098", "520", "AC-012", "ACE_OVER", "小小", "淡淡的忧伤")
复制代码
补充1:字符串暂限定长度为 256 。
补充2:如果支持中文拼音排序就更好了 ...
作者: CrLf 时间: 2015-1-16 00:08
写了个冒泡的
话说和不用 str2hex 的结果没区别嘛...
不知道这样是不是按 Local 顺序排列的- arr = Array("ACE_OVER", "AC-012", "-1","@fas" ,"520", "淡淡的忧伤", "098", "小小")
-
- For i=0 To UBound(arr)
- arr(i) = str2hex(arr(i))
- Next
-
- For i=1 To UBound(arr)
- For j=i To 1 Step -1
- If CStr(arr(j))<CStr(arr(j-1)) Then
- tmp = arr(j)
- arr(j) = arr(j-1)
- arr(j-1) = tmp
- End If
- Next
- Next
-
- For i=0 To UBound(arr)
- WScript.Echo (arr(i))
- WScript.Echo hex2str(arr(i))
- Next
-
- Function str2hex(str)
- Dim i,char,arr()
- ReDim arr(Len(str))
- For i=1 To Len(str)
- char = Mid(str,i,1)
- If Asc(char)<0 Then
- arr(i-1) = char
- Else
- arr(i-1) = "\x" & Right("0" & Hex(Asc(char)),2)
- End If
- Next
-
- str2hex = Join(arr,"")
- End Function
-
- Function hex2str(hexstr)
- Dim i
- For i=0 To 127
- If i <> 92 Then
- hexstr = Replace(hexstr,"\x" & Right("0" & Hex(i),2),Chr(i))
- End If
- Next
-
- hex2str = Replace(hexstr,"\x5c","\")
- End Function
复制代码
作者: CrLf 时间: 2015-1-16 00:09
如果不涉及字节操作,还是 js 好用啊
作者: Demon 时间: 2015-1-16 00:14
我是来围观的
作者: yu2n 时间: 2015-1-16 00:30
放上我的解 ... 嗯 ... 支持64个中英文字符,超过64的,按64个算:- arr = Array("ACE_OVER" & String(999, "_"), "AC-012", "520", "淡淡的忧伤", "098", "小小")
- arr2 = arr
-
- For i = 0 To UBound(arr)
- For j = i + 1 To UBound(arr)
- If Summary(arr, i) > Summary(arr, j) Then
- t = arr(i)
- arr(i) = arr(j)
- arr(j) = t
- End If
- Next
- Next
-
- WScript.Echo Join(arr2, ", ") & vbCrLf & vbCrLf & "=>" & vbCrLf & vbCrLf & Join(arr, ", ")
-
- Function Summary(ByVal arr, ByVal nIndex)
- nMaxLen = 64
- nLen = Len(arr(nIndex))
- If nLen > nMaxLen Then nLen = nMaxLen
- For n = 1 To nLen
- nCount = nCount + Abs(AscW(Mid(arr(nIndex), n, 1))) * (65535 ^ (nMaxLen - n))
- Next
- Summary = nCount
- End Function
复制代码
作者: CrLf 时间: 2015-1-16 01:10
回复 5# yu2n
科学计数法不靠谱吧,受精度限制,只有头几个字是准的,后面就只保留位数了,给个反例:- 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
- 排序算法:冒泡排序
- 排序条件:字符串逐个字符按字符码(AscW函数)升序排序
-
- 方法1: CStr(字符串) 直接比较大小
-
- 方法2: 字符串 -> 拆分单个字符
- -> 转16进制(Hex)表示
- -> 合并Hex字符串
- -> CStr(Hex字符串) 比较大小
-
- 方法3: 字符串 -> 拆分单个字符
- -> 计算单个字符的“权重”:AscW(Chr_) * 65536 ^ (最大字符串长度 - 当前字符位置)
- -> 累加单个字符的“权重”
- -> 比较累加后的字符串“权重”大小
-
- Ps:
- 方法1 使用 CStr() 直接达成排序条件,推荐使用。
- 本人因为之前测试方法有误,测试失败就没采用 ... 后来测试CStr()可用。
-
- 方法2 应该可以在比较特殊的情况下使用。
-
- 方法3 “权重”数值太大,超范围会失效。不建议使用。
复制代码
作者: yu2n 时间: 2015-1-21 06:50
贴个代码留念~- ' 『表格字符串』指定列名、列号排序 by yu2n
-
- ' 指定列名(usr)排序:
- ' sn,usr,pwd
- ' 01,CCC,D00
- ' 02,BBB,E11
- ' 03,AAA,F22
- ' =>
- ' sn,usr,pwd
- ' 03,AAA,F22
- ' 02,BBB,E11
- ' 01,CCC,D00
-
- ' 指定列序号(2)排序:
- ' 01,CCC,D00
- ' 02,BBB,E11
- ' 03,AAA,F22
- ' =>
- ' 03,AAA,F22
- ' 02,BBB,E11
- ' 01,CCC,D00
-
- Demo
- Sub Demo()
- sField = "sn,usr,pwd"
- sContent = "01,CCC,D00" & vbCrLf _
- & "02,BBB,E11" & vbCrLf _
- & "03,AAA,F22"
- ' 指定列名排序
- sTable = sField & vbCrLf & sContent
- WScript.Echo "指定列名(usr)排序:" & vbCrLf & sTable & vbCrLf & "=>" _
- & vbCrLf & SortTableString(sTable, "usr", ",") & vbCrLf
- ' 指定列序号排序
- sTable = sContent
- WScript.Echo "指定列序号(2)排序:" & vbCrLf & sTable & vbCrLf & "=>" _
- & vbCrLf & SortTableString(sTable, 2, ",") & vbCrLf
- End Sub
-
- Function SortTableString(ByVal sTable, ByVal sField, ByVal sFlag)
- ' Format String
- sTable = Trim(sTable)
- If Left(sTable, 2) = vbCrLf Then sTable = Right(sTable, Len(sTable) - 2)
- If Right(sTable, 2) = vbCrLf Then sTable = Left(sTable, Len(sTable) - 2)
- If InStr(sTable, vbCrLf) < 1 Or InStr(sTable, sFlag) < 1 Then Exit Function
- ' init ...
- Dim arr(), arrRows, arrCols, nRowStart
- arrRows = Split(sTable, vbCrLf)
- If UBound(arrRows) = 0 Then Exit Function
- nRowStart = 0
- nRows = UBound(arrRows)
- nCols = UBound(Split(arrRows(0), sFlag))
- ReDim Preserve arr(nCols, nRows)
- For nRow = 0 To nRows
- arrCols = Split(arrRows(nRow), sFlag)
- For nCol = 0 To nCols
- ' Set Table
- arr(nCol, nRow) = arrCols(nCol)
- ' Get nField Index
- If nRow = 0 Then
- If sField = nCol + 1 Then nField = nCol
- If sField = arrCols(nCol) Then nField = nCol: nRowStart = 1
- End If
- Next
- Next
- ' Sort by Field_Index/Field_Name
- Dim i, j, tmp
- For i = nRowStart To nRows
- For j = i + 1 To nRows
- If CStr(arr(nField, i)) > CStr(arr(nField, j)) Then
- tmp = arrRows(i)
- arrRows(i) = arrRows(j)
- arrRows(j) = tmp
- End If
- Next
- Next
- ' Output
- SortTableString = Join(arrRows, vbCrLf)
- End Function
复制代码
欢迎光临 批处理之家 (http://www.bathome.net/) |
Powered by Discuz! 7.2 |