Как удалить дубликат из массива с помощью скрипта vb без использования объектов словаря?

Question

Я пытаюсь удалить дубликаты из массива, используя для цикла и условного оператора. Но я не могу создать новый массив без каких-либо дубликатов. Существует 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

два варианта, в зависимости от ваших потребностей:

1. Попробуйте использовать хэш-таблицу названий стран. При вводе значений в хэш-таблицу вы можете выполнить одновременную проверку, чтобы увидеть, встретите ли вы одинаковое значение. Если он найдет один, он прервет ввод нового значения и продолжит работу со следующей, иначе он будет введен в таблицу. В конце вы получите список уникальных названий стран.

2. Сортировка списка стран, а затем сделать второй проход, который удаляет дубликаты стран (с дубликатами теперь будут сгруппированы вместе)

Проблемы с обоими из этих методов является то, что они не сохраняют первоначальный порядок, если только вы сохраняете какое-то «исходное значение индекса», а затем сортируете на основе этого значения после удаления дубликатов.

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

Это можно было бы сделать более простой способ с помощью разделения команды. Пожалуйста, проверьте приведенное ниже решение, если какое-либо разъяснение сообщит мне.

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