一个数组的算法

Question

比如有一组数据字符串"123;abc123;abc456;abc123;123;"
按";"号可以变为数组.现在需要一个函数,然后排序成"123;abc123;abc456;"
当中的规则是把重复的字符串去掉,并按从小到大的顺序输出来.希望这个函数的算法\简洁\高效...
特向高手请教...
谢谢...

Answer 1

clear_zero
呵呵,是啊...

Answer 2

split 分割成数组
循环比较写进另一个数组,把重复的剔除
然后转换成asc码,比较大小 排列

Answer 3

我写了一个,但是不能实现去掉重复的,并且感觉代码冗长,所以才请教一下各位的:
谢谢,高手指点一下,谢谢..Function datadesc(ByVal outdate)
Dim tmp As String
Dim ary() As String
Dim k As Integer
Dim desc_i As Integer
Dim desc_j As Integer
Dim datadescstr1 As String
Dim datadescstr0 As String
datadescstr1 = outdate
tmp = ""
ary = Split(datadescstr1, ";")
For k = 0 To UBound(ary)
For desc_i = 0 To UBound(ary) - 1
If (ary(desc_i)) >= (ary(desc_i + 1)) Then '如果这里为>则是从小到排，如果是<则是从大到小排
tmp = ary(desc_i + 1)
ary(desc_i + 1) = ary(desc_i)
ary(desc_i) = tmp
End If
Next
Next
datadescstr1 = ""
For desc_j = 1 To UBound(ary)
datadescstr0 = RTrim(LTrim(ary(desc_j)))
datadescstr1 = datadescstr1 & datadescstr0 & ";"
Next
datadesc = datadescstr1
End Function

Answer 4

这有个字符串去掉重复项的示例，没有排序，你参考一下
Private Sub Form_Load()
  Dim Arr, k%, a$
    Dim Dic As Object, Itm    a = "#13,#107,#90,#94,#17,#94,#106,#120,#20,#120,#99,#111,#23,#111,#114,#107,#13,#17,#20,#23"
    Arr = Split(a, ",")
    Set Dic = CreateObject("Scripting.Dictionary")
    For k = 0 To UBound(Arr)
        Dic(Arr(k)) = Dic(Arr(k)) + 1
    Next
    For Each Itm In Dic
        If Dic(Itm) > 1 Then Dic.Remove (Itm)
    Next
    a = Join(Dic.keys, ","): Set Dic = Nothing
    Me.Caption = a
End Sub

Answer 5

dbcontrols,谢谢您.
晕了,你上面代码好多都看不懂...

Answer 6

我给你个偷懒的方法哈，建立一个collection
循环数组的时候就一个一个往里面加，handle就是字符串本身。你阅读一下collection的方法就知道了然后把这个collection放到一个recordset里面，然后调用这个recordset.sort 就排好了。不支持你这么做，这样的结果就是不知其所以然。不过简单省脑子

Answer 7

Const ForAppending = 8
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adCmdText = -1
'Const adCmdText = &H0001 
Set objConnection = CreateObject("ADODB.Connection") 
Set objRecordSet = CreateObject("ADODB.Recordset") 
strPathToTextFile = "D:\" 
strFile = "77.txt" 
objConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _       
"Data Source=" & strPathtoTextFile & ";" & _           
"Extended Properties=""text;HDR=NO;FMT=Delimited""" 
objRecordSet.Open "Select DISTINCT * FROM " & strFile, _     
objConnection, adOpenStatic, adLockOptimistic, adCmdText 
Do Until objRecordSet.EOF   
str = objRecordSet.Fields.Item(0).Value
Dim fso, f
Set fso= CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile("D:\88.txt", ForAppending, True)
f.WriteLine str & ""
f.Close
objRecordSet.MoveNext
Loop 
MsgBox "运行结束"把原始数据放入77.txt里，一行一个，然后处理结果生成在88.txt里，自动去掉重复行而且是排序好的

Answer 8

clear_zero、wowfiowow
谢谢您们了，不过这些方法,也太另类了吧?

Answer 9

如果全是数字的话有简单的办法
a = "333,555,111"
aa = Split(a, ",")
Set x = CreateObject("Scripting.Dictionary")
For Each i In aa
x.Item(CStr(i)) = Empty
Next
Dim z():ReDim z(0)
max = 0
For Each i In x.Keys
If CLng(i) > max Then ReDim Preserve z(i):max = CLng(i)
z(CLng(i)) = CLng(i)
Next
a = Join(z,",")
max = 0
While Len(a) <> max
max = Len(a)
a = Replace(a,",,",",")
Wend
MsgBox a

Answer 10

wowfiowow
谢谢您，不是全是数字，都是不规则的字符串。

Answer 11

Function datadesc(outdate As String) As String
    Dim outdates() As String, strfiltered() As String
    Dim strTemp As String
    Dim i As Integer, j As Integer, k As Integer
    Dim isExist As Boolean
    outdates = Split(outdate, ";")
    k = -1
    '去掉重复的字符串
    For i = 0 To UBound(outdates)
        If i > 0 Then
            For j = 0 To UBound(strfiltered)
                If outdates(i) = strfiltered(j) Then
                    isExist = True
                    Exit For
                End If
            Next
        End If
        If isExist = False Then
            k = k + 1
            ReDim Preserve strfiltered(k)
            strfiltered(k) = outdates(i)
        Else
            isExist = False
        End If
    Next
    '按小到大的顺序排列
    For i = 0 To UBound(strfiltered)
        For j = i + 1 To UBound(strfiltered)
            If Val(strfiltered(i)) > Val(strfiltered(j)) Then
                strTemp = strfiltered(i)
                strfiltered(i) = strfiltered(j)
                strfiltered(j) = strTemp
            End If
        Next
    Next
    strTemp = ""
    '输出
    For i = 0 To UBound(strfiltered)
        strTemp = strTemp & strfiltered(i) & ";"
    Next
    datadesc = strTemp
End FunctionPrivate Sub Command1_Click()
    MsgBox datadesc("123;abc123;abc456;abc123;123;")
End Sub

Answer 12

好把，那就只好使出绝招了a = "123;abc123;abc456;abc123;123"
aa = Split(a,";")set fso = CreateObject("Scripting.FileSystemObject")
For Each i In aa
Set a = fso.opentextfile("c:\xxxxx\" & i & ".txt",1,TRUE)
a.Close
NextSet x = fso.GetFolder("c:\xxxxx").Files
For Each i In x
s = s & i & vbCrLf
Next
MsgBox s
注意提前手动建立一个c:\xxxxxx文件夹，用完删除就行了

Answer 13

给你来个全自动的吧
a = "123;abc123;abc456;abc123;123"
aa = Split(a,";")set fso = CreateObject("Scripting.FileSystemObject")
fso.CreateFolder "c:\xxxxxxxxx"
For Each i In aa
Set a = fso.opentextfile("c:\xxxxxxxxx\" & i & ".txt",1,TRUE)
a.Close
NextSet x = fso.GetFolder("c:\xxxxxxxxx").Files
For Each i In x
s = s & Mid(i,14,Len(i)-17) & vbCrLf
Nextfso.DeleteFolder "c:\xxxxxxxxx"
Set fso = Nothing
MsgBox s

Answer 14

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long
Const LB_FINDSTRING = &H18F
Const LB_ERR = (-1)Private Sub Command1_Click()
   Dim s() As String, i As Integer
   s = Split("123;abc123;abc456;abc123;123", ";")
   For i = 0 To UBound(s)
       chd (s(i))
   Next
End SubPrivate Sub chd(ByVal itm As String)
  Dim Ret As Long
  Ret = SendMessage(List1.hwnd, LB_FINDSTRING, 0&, itm)
  If Ret = LB_ERR Then
     '要排序的话，在list1的属性栏里设置sorted为true
     List1.AddItem itm
  Else
     List1.ListIndex = Ret
  End If
  
End Sub

Answer 15

支持猴哥。补一点：Private Sub Command1_Click()
   Dim s() As String, i As Integer
   s = Split("123;abc123;abc456;abc123;123", ";")   For i = 0 To UBound(s)
       chd (s(i))
   Next   Redim s(List1.ListCount - 1)
   For i = 0 To UBound(s)
       s(i) = List1.List(i)
   Next
End Sub只怕老师不是这样想的，他要排序算法之类。

Answer 16

kimmes,谢谢您,好像的程序还是有点问题,运行了一下,还会加一个";"号出来的.
wowfiowow of123 猴哥,不行啊.
是要算法..不能这样的呀..

Answer 17

Function datadesc(ByVal outdate)
    Dim tmp As String
    Dim ary() As String
    Dim i As Long, j As Long
    Dim s As String
    
    ary = Split(outdate, ";")
    For i = 0 To UBound(ary) - 1
        For j = i + 1 To UBound(ary) - 1
            If ary(j) < ary(i) Then
                tmp = ary(j)
                ary(j) = ary(i)
                ary(i) = tmp
            ElseIf ary(j) = ary(i) Then
                ary(j) = ""
            End If
        Next
        s = s & IIf(ary(i) = "", "", ";" & ary(i))
    Next
    
    datadesc = Mid(s & ";", 2) ' 后面的分号随自己意思去掉或不去掉
End Function

Answer 18

楼上的都正经一点啊 有好的算法共享一下能死啊
字符串比较跟数字比较是不同的 10>2 非常正确 但 "10"<"2"

Answer 19

andy95800,谢谢您.
king06...
爱死你啦..
历害啊

Answer 20

如果你要正规写法那我觉得大家不应该帮你，难道这里是帮人写作业的？都帮你写了你毕业啥都不会到哪找工作啊PS:用list的办法真是老掉牙，早就想到了，不想用而已，一点创意都么有 - -

Answer 21

老师说了这道作业题的考察点主要有两个：
1.instr、split、ubound等字符串基本处理函数
2.排序算法老师还说了，不要写的太深奥，看不懂的

Answer 22

其实这个问题涉及到一个按什么规则进行字符串的排序问题 
a10
a2
我说a10排在a2前面大家一般不会反对 因为按默认的字符串排序规则就是这样；
如果我说a2该排在a10前面而且很有根据，因为除掉相同的字符a后 2<10 所以a2<a10 a2排在前面，不信的去资源管理器中看看，windows就是这么排序文件/文件夹的
所以说排序规则要事先定好

Answer 23

呵呵,结贴先.
谢谢各位的帮忙啦..
特别是king06.谢谢了...

Answer 24

额 还有说正解的....
Dim a As String, b As String
a = 2
b = 10
Debug.Print a > b
自己运行看看再说吧

Answer 25

andy95800
对啊,,,不行啊..
结果是a>b

Answer 26

你意思是最后面多出一个“;”号吗？可以在重新处理一次就可以了就可以!
我最后的那行代码：datadesc = strTemp
改成：datadesc = left(strTemp,len(strTemp)-1) 就可以了！

Answer 27

Dim a As String, b As String
a = 2
b = 10
if isnumberic(a) and isnumberic(a) then 
  Debug.Print val(a) > val(b)
else
  Debug.Print a > b
end if

Answer 28

错了个字母。
Dim a As String, b As String
a = 2
b = 10
if isnumberic(a) and isnumberic(b) then 
  Debug.Print val(a) > val(b)
else
  Debug.Print a > b
end if