Private Sub Form_Load()
Dim I As Long
For I = 0 To UBound(A)
'产生随机字符串.
A(I) = Chr(CLng(65 + Rnd() * (Asc("z") - Asc("A"))))
A(I) = A(I) & Chr(CLng(65 + Rnd() * (Asc("z") - Asc("A"))))
Next
End Sub
Private Sub Command1_Click()
Dim B() As Long
Dim OleVal As String
Dim I As Long
Dim ID As Long
'排序
Call StrSortZA(A, 0, UBound(A))
For I = 0 To UBound(A)
If OleVal = A(I) Then
ID = ID + 1
ReDim Preserve B(ID)
B(ID - 1) = I '将相同的字符串保存在数组 B 中
End If
OleVal = A(I)
Next
Public Sub StrSortZA(ByRef sArr() As String, First As Long, Last As Long)
Dim vSplit As String, vT As String
Dim I As Long, j As Long, iRand As Long
If First < Last Then
If Last - First = 1 Then
If sArr(First) < sArr(Last) Then
vT = sArr(First): sArr(First) = sArr(Last): sArr(Last) = vT
End If
Else
iRand = Int(First + (Rnd * (Last - First + 1)))
vT = sArr(Last): sArr(Last) = sArr(iRand): sArr(iRand) = vT
vSplit = sArr(Last)
Do
I = First: j = Last
Do While (I < j) And (sArr(I) >= vSplit)
I = I + 1
Loop
Do While (j > I) And (sArr(j) <= vSplit)
j = j - 1
Loop
If I < j Then
vT = sArr(I): sArr(I) = sArr(j): sArr(j) = vT
End If
Loop While I < j
If (I - First) < (Last - I) Then
StrSortZA sArr(), First, I - 1
StrSortZA sArr(), I + 1, Last
Else
StrSortZA sArr(), I + 1, Last
StrSortZA sArr(), First, I - 1
End If
End If
End If
End Sub