Einzigartige Liste von Dynamikbereich Tabelle mit möglichen Rohlingen

Question

Ich habe eine Excel-Tabelle in sheet1, in der Spalte A:

Firmennamen
Firma 1
Company 2

Firma Firma 1

Unternehmen 4
Firma 1
Firma

ich möchte eine eindeutige Liste von Firmennamen sie extrahieren et2 auch in Spalte A. Ich kann das nur mit Hilfe einer Hilfssäule tun, wenn ich keine Leerzeichen zwischen den Firmennamen habe, aber wenn ich das habe, bekomme ich eine weitere Firma, die leer ist.

Auch ich habe recherchiert, aber das Beispiel war für nicht dynamische Tabellen und so funktioniert es nicht, weil ich die Länge meiner Spalte nicht kenne.

Ich möchte in Sheet2 Spalte A:

Firmenname
Firma 1
Company 2
Company 3
Firma 4

für die Lösung, die weniger Rechenleistung erfordert Excel oder Excel-VBA. Die endgültige Reihenfolge, die sie in Blatt 2 erscheinen, ist nicht wirklich wichtig.

Answer 1

eine leichte Modifikation Recorder erzeugten Code verwendet:

Sub Macro1() 
    Sheets("Sheet1").Range("A:A").Copy Sheets("Sheet2").Range("A1") 
    Sheets("Sheet2").Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes 
     With Sheets("Sheet2").Sort 
     .SortFields.Clear 
     .SortFields.Add Key:=Range("A2:A" & Rows.Count) _ 
      , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
     .SetRange Range("A2:A" & Rows.Count) 
     .Header = xlGuess 
     .MatchCase = False 
     .Orientation = xlTopToBottom 
     .SortMethod = xlPinYin 
     .Apply 
    End With 
End Sub 

Probe Tabelle1:

Probe Sheet2:

Die Sortierung entfernt die Leerzeichen.

---

EDIT # 1:

Wenn die ursprünglichen Daten in Tabelle1 aus den Formeln abgeleitet wurde, dann wird unter Verwendung Paste unerwünschte Formel Kopier entfernen.Es gibt auch eine letzte Sweep für leere Zellen:

Sub Macro1_The_Sequel() 
    Dim rng As Range 

    Sheets("Sheet1").Range("A:A").Copy 
    Sheets("Sheet2").Range("A1").PasteSpecial Paste:=xlPasteValues 
    Sheets("Sheet2").Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes 
    Set rng = Sheets("Sheet2").Range("A2:A" & Rows.Count) 
    With Sheets("Sheet2").Sort 
     .SortFields.Clear 
     .SortFields.Add Key:=rng, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
     .SetRange rng 
     .Header = xlGuess 
     .MatchCase = False 
     .Orientation = xlTopToBottom 
     .SortMethod = xlPinYin 
     .Apply 
    End With 
    Call Kleanup 
End Sub 

Sub Kleanup() 
    Dim N As Long, i As Long 

    With Sheets("Sheet2") 
     N = .Cells(Rows.Count, "A").End(xlUp).Row 
     For i = N To 1 Step -1 
      If .Cells(i, "A").Value = "" Then 
       .Cells(i, "A").Delete shift:=xlUp 
      End If 
     Next i 
    End With 
End Sub 

Answer 2

Mit zwei Blättern genannt 1 und 2

Innenblatt mit dem Namen: 1

+----+-----------------+ 
| |  A  | 
+----+-----------------+ 
| 1 | Name of company | 
| 2 | Company 1  | 
| 3 | Company 2  | 
| 4 |     | 
| 5 | Company 3  | 
| 6 | Company 1  | 
| 7 |     | 
| 8 | Company 4  | 
| 9 | Company 1  | 
| 10 | Company 3  | 
+----+-----------------+ 

Ergebnis in Blatt mit dem Namen: 2

+---+-----------------+ 
| |  A  | 
+---+-----------------+ 
| 1 | Name of company | 
| 2 | Company 1  | 
| 3 | Company 2  | 
| 4 | Company 3  | 
| 5 | Company 4  | 
+---+-----------------+ 

Verwendung Dieser Code in einem normalen Modul:

Sub extractUni() 
    Dim objDic 
    Dim Cell 
    Dim Area As Range 
    Dim i 
    Dim Value 

    Set Area = Sheets("1").Range("A2:A10") 'this is where your data is located 

    Set objDic = CreateObject("Scripting.Dictionary") 'use a Dictonary! 

    For Each Cell In Area 
     If Not objDic.Exists(Cell.Value) Then 
      objDic.Add Cell.Value, Cell.Address 
     End If 
    Next 

    i = 2 '2 because the heading 
    For Each Value In objDic.Keys 
     If Not Value = Empty Then 
      Sheets("2").Cells(i, 1).Value = Value 'Store the data in column D below the heading 
      i = i + 1 
     End If 
    Next 
End Sub 

Der Code gibt das Datum unsortiert zurück, genau wie die Daten angezeigt werden.

, wenn Sie eine sortierte Liste wollen, fügen Sie einfach diesen Code vor dem las Zeile:

Dim sht As Worksheet 
    Set sht = Sheets("2") 

    sht.Activate 
    With sht.Sort 
     .SetRange Range("A:A") 
     .Header = xlYes 
     .MatchCase = False 
     .Orientation = xlTopToBottom 
     .SortMethod = xlPinYin 
     .Apply 
    End With 

Auf diese Weise wird das Ergebnis immer sortiert werden.

Sub extractUni() 
    Dim objDic 
    Dim Cell 
    Dim Area As Range 
    Dim i 
    Dim Value 

    Set Area = Sheets("1").Range("A2:A10") 'this is where your data is located 

    Set objDic = CreateObject("Scripting.Dictionary") 'use a Dictonary! 

    For Each Cell In Area 
     If Not objDic.Exists(Cell.Value) Then 
      objDic.Add Cell.Value, Cell.Address 
     End If 
    Next 

    i = 2 '2 because the heading 
    For Each Value In objDic.Keys 
     If Not Value = Empty Then 
      Sheets("2").Cells(i, 1).Value = Value 'Store the data in column D below the heading 
      i = i + 1 
     End If 
    Next 

    Dim sht As Worksheet 
    Set sht = Sheets("2") 

    sht.Activate 
    With sht.Sort 
     .SetRange Range("A:A") 
     .Header = xlYes 
     .MatchCase = False 
     .Orientation = xlTopToBottom 
     .SortMethod = xlPinYin 
     .Apply 
    End With 
End Sub 

Wenn Sie Fragen über den Code haben (Die subrutine so sein würde), ich werde froh zu erklären.

Answer 3

Hier ist eine andere Methode in Excel integrierten in Remove Duplicates-Funktion und ein programmiertes Verfahren die Leerzeilen zu entfernen:

EDIT

ich den Code gelöscht haben die obige Methode verwendet, da es zu lange dauert, zu rennen. Ich habe es mit einer Methode ersetzt, die das Sammlungsobjekt von VBA verwendet, um eine eindeutige Liste von Unternehmen zu erstellen.

Die erste Methode auf meiner Maschine dauerte ungefähr zwei Sekunden. die Methode unten: etwa 0,02 Sekunden.

Sub RemoveDups() 
    Dim wsSrc As Worksheet, wsDest As Worksheet 
    Dim rRes As Range 
    Dim I As Long, S As String 
    Dim vSrc As Variant, vRes() As Variant, COL As Collection 


Set wsSrc = Worksheets("sheet1") 
Set wsDest = Worksheets("sheet2") 
    Set rRes = wsDest.Cells(1, 1) 

'Get the source data 
With wsSrc 
    vSrc = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)) 
End With 

'Collect unique list of companies 
Set COL = New Collection 
On Error Resume Next 
For I = 2 To UBound(vSrc, 1) 'Assume Row 1 is the header 
    S = CStr(Trim(vSrc(I, 1))) 
    If Len(S) > 0 Then COL.Add S, S 
Next I 
On Error GoTo 0 

'Populate results array 
ReDim vRes(0 To COL.Count, 1 To 1) 

'Header 
vRes(0, 1) = vSrc(1, 1) 

'Companies 
For I = 1 To COL.Count 
    vRes(I, 1) = COL(I) 
Next I 

'set results range 
Set rRes = rRes.Resize(UBound(vRes, 1) + 1) 

'Write the results 
With rRes 
    .EntireColumn.Clear 
    .Value = vRes 
    .EntireColumn.AutoFit 

    'Uncomment the below line if you want 
    '.Sort key1:=.Columns(1), order1:=xlAscending, MatchCase:=False, Header:=xlYes 

End With 

End Sub 

HINWEIS: Sie schreiben Sie nicht über die Reihenfolge scherten, aber wenn Sie möchten, um die Ergebnisse zu sortieren, die etwa 0,03 Sekunden auf die Routine hinzugefügt.

Answer 4

Alle diese Antworten verwenden VBA. Der einfachste Weg dazu ist die Verwendung einer Pivot-Tabelle.

Zuerst Ihre Daten auswählen, einschließlich der Kopfzeile, und gehen Sie auf Einfügen -> Pivot-Tabelle:

Dann werden Sie ein Dialogfeld. Sie müssen hier keine der Optionen auswählen, klicken Sie einfach auf OK. Dadurch wird ein neues Blatt mit einer leeren Pivot-Tabelle erstellt. Sie müssen dann Excel mitteilen, welche Daten Sie suchen. In diesem Fall möchten Sie nur die Name of company im Bereich Zeilen. Auf der rechten Seite von Excel sehen Sie einen neuen Abschnitt namens PivotTable Fields.In diesem Abschnitt einfach klicken und die Header an den Abschnitt Zeile ziehen:

Dies wird ein Ergebnis mit nur dem eindeutigen Namen und einen Eintrag mit (blank) am Boden geben:

Wenn Sie die Pivot-Tabelle nicht weiter verwenden möchten, kopieren Sie einfach die gewünschten Ergebniszeilen (in diesem Fall die eindeutigen Firmennamen) in eine neue Spalte oder ein neues Blatt, um nur solche ohne Pivot zu erhalten Tabelle beigefügt. Wenn Sie die Pivot-Tabelle beibehalten möchten, können Sie mit der rechten Maustaste auf Gesamtsumme klicken und diese entfernen sowie die Liste filtern, um den Eintrag (blank) zu entfernen.

So oder so, Sie haben jetzt Ihre Liste von einzigartigen Ergebnissen ohne Leerzeichen und es brauchte keine Formeln oder VBA, und es dauerte relativ wenige Ressourcen zu vervollständigen (weit weniger als jede VBA oder Formel Lösung).