Public Function IsInArray(ByVal sData As String, ByVal vData As Variant) As Boolean ‘某字符串是否在某一维数组中
IsInArray = False
If Not IsArray(vData) Then Exit Function
If IsEmptyArray(vData) Then Exit Function
Dim I As Integer
For I = LBound(vData) To UBound(vData)
If sData = vData(I) Then IsInArray = True
Next I
End Function
Public Function IsEmptyArray(ByVal sArray As Variant) As Boolean ‘判断一维数组为空或者尚未初始化
‘类似 Dim TestArray(0 To 2) As String，一经申明，各元素即被赋 “” 值，IsEmptyArray 为 False；
‘类似 Dim TestArray() As String，虽经申明，仍为空数组，IsEmptyArray 为 True。
Dim I As Integer, J As Integer
On Error GoTo ERR_EMPTY
I = UBound(sArray) ‘试错
If LBound(sArray) > UBound(sArray) Then GoTo ERR_EMPTY
IsEmptyArray = False
On Error GoTo 0
Exit Function
ERR_EMPTY:
IsEmptyArray = True
On Error GoTo 0
End Function
Public Function IndexInArray(ByVal sData As String, ByVal vData As Variant) As Integer ‘某数值在某一维数组中的位次(以最小号为准, 不存在则为 -1)
Dim I As Integer, J As Integer
IndexInArray = -1
If Not IsArray(vData) Then Exit Function
If IsEmptyArray(vData) Then Exit Function
For I = LBound(vData) To UBound(vData)
If LCase(sData) = LCase(vData(I)) Then
IndexInArray = I
Exit For
End If
Next I
End Function
Public Sub CleanUpArray(vData As Variant) ‘剔除数组中的重复数据
If Not IsArray(vData) Then Exit Sub ‘数组判断
If IsEmptyArray(vData) Then Exit Sub
Dim LO, HI As Integer ‘上下界
LO = LBound(vData)
HI = UBound(vData)
Dim I, J, KCount As Integer
KCount = 0 ‘计数器
Dim DupeIndex() As String ‘重复数据的序号组成的数组，记后不记前
For I = HI To LO Step -1
For J = I – 1 To LO Step -1
If vData(I) = vData(J) Then
KCount = KCount + 1
ReDim Preserve DupeIndex(1 To KCount) As String
DupeIndex(KCount) = CStr(I)
Exit For
End If
Next J
Next I
If KCount > 0 Then ‘有重复
Dim iCount As Integer
iCount = LO – 1 ‘计数器
Dim TempArray() As String
For I = LO To HI
If Not IsInArray(CStr(I), DupeIndex()) Then ‘首次出现或未重复的数据
iCount = iCount + 1
ReDim Preserve TempArray(LO To iCount) As String
TempArray(iCount) = vData(I)
End If
Next I
ReDim vData(LO To iCount) ‘ As String ‘重新赋值并返回
For I = LO To iCount
vData(I) = TempArray(I)
Next I
Else
‘无重复，不处理
End If
Erase DupeIndex
End Sub