VBA, usuwanie duplikatów z tablicy

Question

Czy ktoś mógłby mi dać kilka wskazówek, jak rozwiązać następujący problem:

Załóżmy Mam bloku danych w programie Excel 2010, 100 wierszy o 3 kolumnach.

Kolumna C zawiera kilka duplikatów, powiedzieć, że zaczyna się jak 1,1,1, 2,3,4,5 ....., 97,98

Korzystanie z VBA, chciałbym, aby usunąć duplikaty wierszy, zgodnie z kolumną C, więc pozostaję z 1,2,3, ....., 97, 98, tj. tylko 98 wierszy i 3 kolumny.

Wiem, że istnieje przycisk, który mogę kliknąć w Excel 2010, aby to zrobić, ale chcę to zrobić w VBA (ponieważ próbowałem tego i z jakiegoś powodu, wtrąca się reszta mojego kodu i podaje błędnie wyniki).

Ponadto, chciałbym zrobić to w macierzy, a następnie wklej wyniki w arkuszu, zamiast metod, takich jak Application.Worksheetfunction.countif (.....

Więc coś takiego:

.

Dim myarray() as Variant 
myarray=cells(1,1).Currentregion.value 

Dim a as Long 

For a=1 to Ubound(myarray,1) 

    'something here to 

Next a 

Answer 1

I answered a similar question Oto kod użyłem:

Dim dict As Object 
Dim rowCount As Long 
Dim strVal As String 

Set dict = CreateObject("Scripting.Dictionary") 

rowCount = Sheet1.Range("A1").CurrentRegion.Rows.Count 

'you can change the loop condition to iterate through the array rows instead 
Do While rowCount > 1 
    strVal = Sheet1.Cells(rowCount, 1).Value2 

    If dict.exists(strVal) Then 
    Sheet1.Rows(rowCount).EntireRow.Delete 
    Else 
    'if doing this with an array, then add code in the Else block 
    ' to assign values from this row to the array of unique values 
    dict.Add strVal, 0 
    End If 

    rowCount = rowCount - 1 
Loop 

Set dict = Nothing 

Jeśli chcesz używać tablicy, następnie pętli elementów z tego samego warunkowe (if/else) st ateny. Jeśli pozycja nie istnieje w słowniku, możesz dodać ją do słownika i dodać wartości wierszy do innej tablicy.

Szczerze mówiąc, myślę, że najbardziej skutecznym sposobem jest dostosowanie kodu można dostać od rejestrator makr. Można wykonać powyższą funkcję w jednym wierszu:

Sheet1.UsedRange.RemoveDuplicates Columns:=3, Header:=xlYes 

Answer 2

Słowniki mieć max 255 przedmiotów, więc jeśli masz więcej wartości trzeba użyć Collection. Niestety obiekt Collection nie ma metody .Contains (a) lub .Exists (a), ale ta funkcja ładnie (podróbka) ładnie, używając numerów błędów:

KOREKTA: Słowniki nie mają takich limit (dzięki Zairja). Być może używałem Integer do iteracji przez mój słownik. W każdym przypadku, funkcja ta pozwala sprawdzić kolekcje dla istnienia elementu, więc będę go tu zostawić, jeśli jest to przydatne każdemu:

CollContainsItem(col As Collection, val As Variant) As Boolean 

Dim itm As Variant 
On Error Resume Next 

    itm = col.Item(val) 
    CollContainsItem = Not (Err.Number = 5 Or Err.Number = 9) 

On Error GoTo 0 

End Function 

Więc jeśli potrzebujemy kolekcji, można prawdopodobnie wystarczy zastąpić

dict.Exists(strVal) 

z

CollContainsItem(coll, strVal) 

i zastąpić

Set dict = CreateObject("Scripting.Dictionary") 

z

Set coll = CreateObject("Scripting.Collection") 

i wykorzystać resztę kodu Zairja użytkownika. (Tak naprawdę nie próbowałem, ale powinno być blisko)

Answer 3

Function eliminateDuplicate(poArr As Variant) As Variant 
Dim poArrNoDup() 

    dupArrIndex = -1 
For i = LBound(poArr) To UBound(poArr) 
     dupBool = False 

     For j = LBound(poArr) To i 
      If poArr(i) = poArr(j) And Not i = j Then 
       dupBool = True 
      End If 
     Next j 

     If dupBool = False Then 
      dupArrIndex = dupArrIndex + 1 
      ReDim Preserve poArrNoDup(dupArrIndex) 
      poArrNoDup(dupArrIndex) = poArr(i) 
     End If 
Next i 

eliminateDuplicate = poArrNoDup 
End Function