Private Sub Command1_Click()
Dim x(100) As String
For i = 0 To 100
x(i) = Chr(i Mod 26 + 65)
Next
MsgBox Join(x, ",")
MsgBox Join(filtera(x), ",")
End Sub
Function filtera(ByRef a() As String)
On Error Resume Next
Dim x As New Collection, b() As String
Dim i As Long
For i = LBound(a) To UBound(a)
x.Add a(i), a(i)
Next
ReDim b(1 To x.Count)
For i = 1 To x.Count
b(i) = x(i)
Next
filtera = b
Erase b
Set x = Nothing
End Function
问题是这样的,在数组里有一些项的值相同,我要把有重复的值的项删除,其它的项保留,请问有甚么简单的方法~?救救小弟阿
'--------------------------------
1.先将数组排序.
2.用一个FOR循环搞定.
如:
Private Sub Command1_Click()
Dim StrArr() As String
Dim I As Long
Dim NewArr() As String
Dim ID As Long
Dim OleVal As String
'处理重复字符串.
For I = LBound(StrArr) To UBound(StrArr)
If I = LBound(StrArr) Or OleVal <> StrArr(I) Then
ID = ID + 1
ReDim Preserve NewArr(ID)
NewArr(ID - 1) = StrArr(I)
End If
OleVal = StrArr(I)
Next
'打印新值.
For I = LBound(NewArr) To UBound(NewArr)
Debug.Print NewArr(I)
Next
End Sub
'字符串排序函数
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