急求一排序函数！

ghost225 2005-12-28 10:28:23

需要将以下内容安一定规则（如先数字0～9后英文字母a~z,A~Z）进行排序，求一排序函数！以下数据存放于.dat文件中！
"A835 Charger"
"A835 Battery"
"AANN4329 Battery V/C980"
"SPN5072 Charger V303"
"C650"
"3G - C975"
"A835"

...全文

379 9 打赏收藏转发到动态举报

写回复

用AI写文章

9 条回复

切换为时间正序

请发表友善的回复…

发表回复

vansoft 2005-12-30

打赏
举报

写什么函数啊?
用province_(雍昊)的方法啊。

只要能达到目的，就是好办法。

rainstormmaster 2005-12-30

打赏
举报

Public Function MergeSort(Strings() As String) As String()

Dim s As Long, i As Long, n() As String, m() As String
Dim u As Long, l As Long, j As Long, x() As String

' we don't sort 1 element!

If (UBound(Strings) - LBound(Strings)) = 0 Then
MergeSort = Strings
Exit Function
ElseIf (UBound(Strings) - LBound(Strings)) = 1 Then
MergeSort = BubbleSort(Strings)
Exit Function
Else
l = SplitArray(Strings, m, n)
m = MergeSort(m)
n = MergeSort(n)
MergeSort = MergeArray(m, n)
End If

End Function

Private Function SplitArray(Strings() As String, _
StringOut1() As String, StringOut2() As String) As Long

' Splits it 50/50 or as close as possible
' if it's just one string, we return StringOut1(0)
' The return number is the total elements of the
' largest of the arrays

Dim i As Long, j As Long, s1() As String, s2() As String
Dim z As Long

If (UBound(Strings) - LBound(Strings)) = 0 Then
StringOut1 = Strings
SplitArray = 1
Exit Function
End If

i = Int((UBound(Strings) + 1) / 2)

z = 0
For j = 0 To (i - 1)
ReDim Preserve StringOut1(z)
StringOut1(z) = Strings(j)
z = z + 1
Next j

z = 0
For j = i To UBound(Strings)
ReDim Preserve StringOut2(z)
StringOut2(z) = Strings(j)
z = z + 1
Next j

If UBound(StringOut1) > UBound(StringOut2) Then
SplitArray = UBound(StringOut1)
Else
SplitArray = UBound(StringOut2)
End If

End Function

Private Function MergeArray(String1() As String, _
String2() As String) As String()

Dim i As Long, j As Long
Dim n() As String, x As Long, y As Long, c As Integer
On Error Resume Next
i = -2
j = -2

i = UBound(String1) + 1
j = UBound(String2) + 1

If (i < 0) And (j < 0) Then Exit Function

If (i > -1) Then
i = UBound(String1) + 1
ElseIf (i = -1) Or ((i = 0) And (String1(0) = "")) Then
MergeArray = String2
Exit Function
End If

If j > -1 Then
i = i + UBound(String2) + 1
ElseIf (j = -1) Or ((j = 0) And (String2(0) = "")) Then
MergeArray = String1
Exit Function
End If

ReDim n(i - 1)

For j = 0 To (i - 1) Step 0
If (x > UBound(String1)) And (y > UBound(String2)) Then
MergeArray = n
Exit Function
End If

c = StrComp(String1(x), String2(y))
If (c = 0) And (x <= UBound(String1) And _
(y <= UBound(String2))) Then
n(j) = String1(x)
n(j + 1) = String2(y)
j = j + 2
y = y + 1
x = x + 1
ElseIf ((c < 0) Or (y > UBound(String2))) _
And (x <= UBound(String1)) Then
n(j) = String1(x)
x = x + 1
j = j + 1
ElseIf ((c > 0) Or (x > UBound(String1))) _
And (y <= UBound(String2)) Then
n(j) = String2(y)
y = y + 1
j = j + 1
End If
Next
MergeArray = n

End Function

Public Function BubbleSort(Strings() As String) As String()

Dim a As Long, b As Long, c As Long, d As Long
Dim e As Integer, f As Integer, g As Integer

Dim i As String, j As String
Dim m() As String, n() As String

e = 1
n = Strings
Do While e <> -1

For a = 0 To UBound(Strings) - 1
i = n(a)
j = n(a + 1)
f = StrComp(i, j)
If f <= 0 Then
n(a) = i
n(a + 1) = j
Else
n(a) = j
n(a + 1) = i
g = 1
End If
Next a
If g = 1 Then
e = 1
Else
e = -1
End If

g = 0
Loop
BubbleSort = n
End Function