VBA: hinzufügen von eindeutigen Werten in einem Bereich, um einen neuen Bereich

Ich habe eine unsortierte Liste von Namen in Tabelle1, Spalte a Viele dieser Namen erscheinen mehr als einmal in der Liste.

In Tabelle2 Spalte A möchte ich eine alphabetisch sortierte Liste der Namen ohne doppelte Werte.

Was ist die optimale Methode, dies zu erreichen, mithilfe von VBA?

Methoden, die ich bisher gesehen habe, gehören:

  1. Machen eine Sammlung mit CStr(name) als Schlüssel, Durchlaufen der Reihe und versuchen, um jeden Namen, und wenn es ein Fehler ist es nicht eindeutig, es zu ignorieren, andere erweitern das Spektrum von 1 Zelle und fügen Sie den Namen
  2. Gleiche wie (1), außer ignorieren, über die Fehler. Wenn die Schleife abgeschlossen ist, werden nur eindeutige Werte werden in der Sammlung: fügen Sie die ganze Sammlung auf den Bereich
  3. Mit dem match-Arbeitsblatt-Funktion auf die Reihe: wenn keine übereinstimmung, erweitern der Auswahl um eine Zelle und fügen Sie den Namen
  4. Vielleicht einige simulation der "Duplikate entfernen" - Taste auf der Registerkarte "Daten"? (habe nicht in diese sah)
  • Ich würde in mit Option 4. 1) ein makro Aufzeichnen 2) Kopieren Col-2 Blatt 3) Wählen Sie Col und drücken Sie die Duplikate entfernen-Taste unter der Registerkarte "Daten", wenn Sie Excel 2007 verwenden 4) Art der Daten 🙂 probieren Sie es aus und wenn du nicht weiter kommst, dann poste zurück 🙂
  • +1 für Siddharth Antwort. Dies sollte sehr einfach sein.
  • Fragen wie diese wurden aufgefordert, so viele Male auf SO... Haben Sie einen Blick auf die vorherigen Antworten (hier zum Beispiel), etwas ausprobieren, sehen, ob es funktioniert, Holen Sie sich zurück zu uns mit Problemen. Dieser und dieser wäre nützlich zu Lesen-auch für Sie.
InformationsquelleAutor Swiftslide | 2012-05-09
  1. 0

    Als Sie schlug vor, ein Wörterbuch von einer Art ist der Schlüssel. Ich würde eine Sammlung - es ist vordefiniert (im Gegensatz zu den Scripting.Wörterbuch) und macht den job.

    Wenn du mit "optimal" meinst du "schnell", der zweite trick ist, nicht auf jede Zelle einzeln. Stattdessen verwenden Sie einen Puffer. Der code unten wird schnell auch mit tausenden von Zeilen der Eingabe.

    Code:

    ' src is the range to scan. It must be a single rectangular range (no multiselect).
' dst gives the offset where to paste. Should be a single cell.
' Pasted values will have shape N rows x 1 column, with unknown N.
' src and dst can be in different Worksheets or Workbooks.
Public Sub unique(src As Range, dst As Range)
    Dim cl As Collection
    Dim buf_in() As Variant
    Dim buf_out() As Variant
    Dim val As Variant
    Dim i As Long

    ' It is good practice to catch special cases.
    If src.Cells.Count = 1 Then
        dst.Value = src.Value   ' ...which is not an array for a single cell
        Exit Sub
    End If
    ' read all values at once
    buf_in = src.Value
    Set cl = New Collection
    ' Skip all already-present or invalid values
    On Error Resume Next
    For Each val In buf_in
        cl.Add val, CStr(val)
    Next
    On Error GoTo 0

    ' transfer into output buffer
    ReDim buf_out(1 To cl.Count, 1 To 1)
    For i = 1 To cl.Count
        buf_out(i, 1) = cl(i)
    Next

    ' write all values at once
    dst.Resize(cl.Count, 1).Value = buf_out

End Sub
    InformationsquelleAutor Torben Klein
  2. 2

    Ich wirklich wie das dictionary-Objekt in VBA. Es ist nicht nativ verfügbar, aber es ist sehr fähig. Müssen Sie fügen Sie einen Verweis auf Microsoft Scripting Runtime dann können Sie etwas wie das hier tun:

    Dim dic As Dictionary
Set dic = New Dictionary
Dim srcRng As Range
Dim lastRow As Integer

Dim ws As Worksheet
Set ws = Sheets("Sheet1")

lastRow = ws.Cells(1, 1).End(xlDown).Row
Set srcRng = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, 1))

Dim cell As Range

For Each cell In srcRng
    If Not dic.Exists(cell.Value) Then
        dic.Add cell.Value, cell.Value   'key, value
    End If
Next cell

Set ws = Sheets("Sheet2")    

Dim destRow As Integer
destRow = 1
Dim entry As Variant

'the Transpose function is essential otherwise the first key is repeated in the vertically oriented range
ws.Range(ws.Cells(destRow, 1), ws.Cells(dic.Count, 1)) = Application.Transpose(dic.Items)
    • Sie können transponieren des Arrays von Wörterbuch-Schlüssel, um die Palette in einem Schritt unter Verwendung von dic.Schlüssel. Probieren Sie es aus 🙂
    • oh, interessant. Ich mag es. Ich aktualisiert meine Antwort zu zeigen, dies zu ändern!
    InformationsquelleAutor Brad
Schreibe einen Kommentar