Question

我正在尝试使用for循环和条件语句从数组中删除重复项。但是我无法创建没有任何重复项的新数组。有xls的国家名称有重复项，我的目的是删除重复项并创建一个新数组具有独特的国家名称。例如

strFilePath="D:\Country.xls"
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible=True
Set objWorkbook = objExcel.Workbooks.Open (strFilePath)
Set objSheet=objExcel.Sheets("Country")

objExcel.DisplayAlerts = False
    objExcel.AskToUpdateLinks = False
    objExcel.AlertBeforeOverwriting = False
Dim A(100)
    Dim B(100)
    For i = 2 To 6 Step 1
             k = i-2
    A(k)=objSheet.Cells(i,1).Value

Next
    B(0)=A(0)
    For j = 0 To 4  Step 1
         strIt=A(j)

For m = 1 To 4 Step 1
        reslt = StrComp(A(m),strIt,1)
             If(reslt = 1 Or reslt = -1) Then
                    c=1
                    B(c)=A(m)
                    c=c+1
                    End if
                m=m+1
            Next
    Next

Answer 1

两种选择，取决于您的需求：

尝试使用国家/地区名称的哈希表。在哈希表中输入值时，您可以同时检查是否遇到相同的值。如果找到一个它将中止输入新值并继续下一个值，否则它将被输入到表中。最后，您将获得唯一国家/地区名称列表。
对国家/地区列表进行排序，然后执行第二次删除，删除重复的国家/地区（因为重复项目现在将分组在一起）

这两种方法的问题在于它们不保留原始订单，除非您保留某种“原始索引”值，然后在删除重复项后根据该值进行排序。

Answer 2

以下是我通常的做法：

Dim uniqueentries()
ReDim uniqueentries(-1)

' Here you could go through your existing array and 
' call "GetUniqueEntries" sub on each entry, e.g.
For Each i In oldarray
    GetUniqueEntries i
Next


Sub GetUniqueEntries(newentry)
    Dim entry
    If UBound(uniqueentries) >= 0 Then ' Only check if uniqieentries contains any entries
        For Each entry In uniqueentries
            If newentry = entry Then Exit Sub ' If the entry you're testing already exists in array then exit sub
        Next
    End If
    ReDim Preserve uniqueentries(UBound(uniqueentries) + 1) ' Increase new array size
    uniqueentries(UBound(uniqueentries)) = newentry ' Add unique entry to new array
End Sub

Answer 3

使用Split命令可以更简单地完成此操作。如果有任何澄清，请查看以下解决方案。

Dim aDupl
Dim aNew, strNew
aDupl = Array("A", "B", "A", "D", "C", "D")
strNew = ""
For iCnt= 0  To UBound(aDupl)
 If InStr(strNew,aDupl(iCnt) ) = 0 Then     
    strNew =strNew&aDupl(iCnt)&","
 End If
Next
aNew = Split(strNew, ",")
For iCnt=0 To UBound(aNew)
 WScript.Echo aNew(iCnt)
Next

如何使用vb脚本从数组中删除重复而不使用字典对象？

3 个答案: