Doppelte Einträge löschen und Liste gleichmäßig aufteilen

  • Excel

Es gibt 4 Antworten in diesem Thema. Der letzte Beitrag () ist von TeamBob.

    Doppelte Einträge löschen und Liste gleichmäßig aufteilen

    Hallo Community,

    ich habe ein kleines Projekt und weis nicht so Recht wie ich es lösen soll.

    Grundsituation:
    Ich habe ein Sheet mit vielen ungeordneten Wörtern. Die Wörter können in 5 verschiedenen Spalten (A:E) stehen.
    Dabei kann in jeder Spalte eine unterschiedliche Anzahl an Wörtern enthalten (z.B. Spalte 1: 100 Wörter | Spalte 2: 46 Wörter...)

    Aufgabe:
    (1) Nun möchte ich, dass alle doppelten Einträge in diesen Spalten gelöscht werden, wobei eine unterschiedliche Schreibweise (z.B. weiß und weiss)
    nicht als doppelt gelten und stehen bleiben müssen. Groß und Kleinschreibung kann jedoch unbeachtet bleiben.

    (2) Als nächster Schritt sollen die Keywords in diese 5 Spalten gleichmäßig aufgeteilt und sortiert werden (z.B. jede Spalte 100 Einträge).


    Umsetzung:
    (1) Ich habe hier bereits einen Code zum löschen von doppelten Einträgen, jedoch nur mit berücksichtigung von einer Spalte und die unterschiedlichen Schreibweisen werden als doppelt geachtet und gelöscht, was leider noch nicht richtig ist.

    (2) Bei der Sortierung und Aufteilung auf 5 Spalten habe ich leider gar keine Idee. VIelleicht alle in eine Spalte schreiben lassen und die
    Anzahl Zellen durch 5 dividieren, um so die anzahl pro wörter pro Spalte zu erhalten?

    Hoffe auf eure Hilfe


    (1)

    Visual Basic-Quellcode

    1. Sub doppelte_Eintraege_finden()
    2. Dim int_Spalte As Integer, int_erste_Zeile As Integer, int_letzte_Zeile As Long, int_x As Integer
    3. Dim str_Auswahl As Variant
    4. int_erste_Zeile = 3
    5. int_Spalte = 1
    6. int_letzte_Zeile = 350
    7. For int_x = int_letzte_Zeile To int_erste_Zeile Step -1
    8. If WorksheetFunction.CountIf(Range(Cells(int_erste_Zeile, int_Spalte), Cells(int_letzte_Zeile, int_Spalte)), Cells(int_x, int_Spalte)) > 1 Then
    9. str_Auswahl = str_Auswahl & "Zelle: " & Cells(int_x, int_Spalte).Address & "mit Inhalt: " & Cells(int_x, int_Spalte).Value & Chr(13)
    10. Cells(int_x, int_Spalte).Value = ""
    11. End If
    12. Next int_x
    13. MsgBox "folgende Zellen würden gelöscht" & Chr(13) & str_Auswahl
    14. End Sub
    Der Grundgedanke ist gut. Wie wä's denn, wenn Du erst alle Wörter in eine Spalte schreibst, dann in einer benachbarten all diese Wörter groß (Stichwort UCase-Funktion), dann die beiden Spalten zusammen nach der Großschreibespalte sortierst, die Begriffe der Großschreibespalte mit ihren Folgewörtern in der nächsten Zeile vergleichst, dann so Duplikate erkennst und die Zeile der Großschreibe- und der normalen Spalte löschst und danach - eben mit dem Rest - Deine Aufteilung durch 5 machst, wie in Punkt 2 von Dir beschrieben?

    btw: Die Suche nach dem Ende einer Spalte ließe sich flexibel so gestalten: For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    Dieser Beitrag wurde bereits 5 mal editiert, zuletzt von „VaporiZed“, mal wieder aus Grammatikgründen.

    Aufgrund spontaner Selbsteintrübung sind all meine Glaskugeln beim Hersteller. Lasst mich daher bitte nicht den Spekulatiusbackmodus wechseln.
    Hallo
    Danke erstmal für deine schnelle Antwort und Hilfestellung :)

    petaod schrieb:

    Warum verwendest du nicht RemoveDuplicates?

    Ich kannte die Funktion gar nicht. Verstehe nicht so recht wie ich diese anwende?

    Ich habe ein wenig rumprobiert und hier mal ein paar Teile des Codes.
    Leider habe ich noch ein paar Probleme:
    (1) Wie bekomme ich alle Einträge von Spalte B:E in die Spalte A
    (2) Momentan werden die doppelten Einträge rot eingefärbt. Wie kann ich die komplete Zeile löschen lassen?
    (3) Ich weis nicht genau wie ich die gleichmäßige Aufteilung in 5 Spalten vornehmen lassen soll.
    Durch 5 dividieren, aber wie sage ich denn, dass er in der ersten Spalte diese Einträge kopieren soll und in der nächsten weiter fortführend?
    Vielen Dank

    Visual Basic-Quellcode

    1. Sub Doppelt_Red()
    2. Dim lngZeile As Long
    3. Application.ScreenUpdating = False
    4. For lngZeile = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    5. If Cells(lngZeile, 1) = Cells(lngZeile + 1, 1) Then
    6. With Range(Cells(lngZeile, 1), Cells(lngZeile + 1, 1))
    7. .Font.Bold = True
    8. .Font.ColorIndex = 3
    9. End With
    10. End If
    11. Next
    12. Application.ScreenUpdating = True
    13. End Sub
    14. Sub UmwandelnInGrossBuchstaben()
    15. Dim Zelle As Range
    16. For Each Zelle In Range("B1:B" & Cells(Rows.Count, 1).End(xlUp).Row)
    17. Zelle = UCase(Zelle.Value)
    18. Next Zelle
    19. End Sub
    20. Sub SpalteKopieren()
    21. Worksheets("Tabelle1").Range("A:A").Copy Destination:=Worksheets("Tabelle1").Range("B:B")
    22. End Sub

    Hallo
    Es funktioniert nun soweit, wobei es sehr langsam ist (vermutlich aufgrund der schlechten Schreibweise).
    Die Funktion zum löschen der Leerzeichen ist sehr langsam, gibt es hier vielleicht was besser.
    Kann man an einer stelle vielleicht Trim einbauen?
    Danke euch

    Visual Basic-Quellcode

    1. Sub SpaltenZusammenfuehren()
    2. Dim spalte As Long
    3. Dim letzte As Long
    4. Dim i As Long
    5. Dim rg As Range
    6. With Sheets("Tabelle1")
    7. If WorksheetFunction.CountA(Range("B:E")) = 0 Then
    8. Exit Sub
    9. Else
    10. spalte = .Cells(1, .Columns.Count).End(xlToLeft).Column 'letzte Spalte ermitteln
    11. For i = 2 To spalte 'von Spalte2 bis letzte Spalte
    12. letzte = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 'erste freie Zeile ermitteln
    13. .Cells(letzte, 1).Resize(.Cells(1, i).End(xlDown).Row, 1).Value = .Cells(1, i).Resize(. _
    14. Cells(1, i).End(xlDown).Row, 1).Value 'nur die Werte uebergeben
    15. Next
    16. .Range(.Columns(2), .Columns(spalte)).Clear 'zu letzt Bereich loeschen
    17. End If
    18. End With
    19. End Sub
    20. Sub Sortieren()
    21. Dim lngLR As Long
    22. lngLR = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)
    23. Range("A1", Cells(lngLR, 1)).Sort Key1:=Range("A1"), Order1:=xlAscending
    24. End Sub
    25. Sub SpalteKopieren()
    26. Worksheets("Tabelle1").Range("A:A").Copy Destination:=Worksheets("Tabelle1").Range("B:B")
    27. End Sub
    28. Sub UmwandelnInGrossBuchstaben()
    29. Dim Zelle As Range
    30. For Each Zelle In Range("B1:B" & Cells(Rows.Count, 1).End(xlUp).Row)
    31. Zelle = UCase(Zelle.Value)
    32. Next Zelle
    33. End Sub
    34. Sub DuplikateEntfernen()
    35. Dim lngZeilen As Long
    36. Application.ScreenUpdating = False
    37. For lngZeilen = 1 To Cells(Rows.Count, 2).End(xlUp).Row
    38. If Cells(lngZeilen, 2) = Cells(lngZeilen + 1, 2) Then
    39. With Range(Cells(lngZeilen, 2), Cells(lngZeilen + 1, 2))
    40. Rows(lngZeilen).Delete Shift:=xlUp
    41. End With
    42. End If
    43. Next
    44. Application.ScreenUpdating = True
    45. End Sub
    46. Sub SpalteLoeschen()
    47. With Sheets("Tabelle1")
    48. .Columns("B:B").Delete
    49. End With
    50. End Sub
    51. Sub SpaltenAufteilen()
    52. Dim RowCount As Long
    53. Dim Spalte1Ende As Integer
    54. Dim Spalte2Anfang As Integer
    55. Dim Spalte2Ende As Integer
    56. Dim Spalte3Anfang As Integer
    57. Dim Spalte3Ende As Integer
    58. Dim Spalte4Anfang As Integer
    59. Dim Spalte4Ende As Integer
    60. Dim Spalte5Anfang As Integer
    61. Dim Spalte6Ende As Integer
    62. With Sheets("Tabelle1")
    63. RowCount = .Cells(.Rows.Count, 1).End(xlUp).Row
    64. CellsPerRow = (RowCount / 5)
    65. CellsPerRowRound = Application.RoundUp(CellsPerRow, 0)
    66. Spalte1Ende = CellsPerRowRound
    67. Spalte2Anfang = CellsPerRowRound + 1
    68. Spalte2Ende = CellsPerRowRound * 2
    69. Spalte3Anfang = CellsPerRowRound * 2 + 1
    70. Spalte3Ende = CellsPerRowRound * 3
    71. Spalte4Anfang = CellsPerRowRound * 3 + 1
    72. Spalte4Ende = CellsPerRowRound * 4
    73. Spalte5Anfang = CellsPerRowRound * 4 + 1
    74. Spalte5Ende = CellsPerRowRound * 5
    75. 'Spalte 1 & 2
    76. Range("A" & Spalte2Anfang & ":A" & Spalte2Ende).Select
    77. Selection.Cut
    78. Range("B1:B" & Spalte1Ende).Select
    79. ActiveSheet.Paste
    80. 'Spalte 3
    81. Range("A" & Spalte3Anfang & ":A" & Spalte3Ende).Select
    82. Selection.Cut
    83. Range("C1:C" & Spalte1Ende).Select
    84. ActiveSheet.Paste
    85. 'Spalte 4
    86. Range("A" & Spalte4Anfang & ":A" & Spalte4Ende).Select
    87. Selection.Cut
    88. Range("D1:D" & Spalte1Ende).Select
    89. ActiveSheet.Paste
    90. 'Spalte 5
    91. Range("A" & Spalte5Anfang & ":A" & Spalte5Ende).Select
    92. Selection.Cut
    93. Range("E1:E" & Spalte1Ende).Select
    94. ActiveSheet.Paste
    95. End With
    96. End Sub
    97. Sub LeerzeichenEntfernen()
    98. Dim Zelle As Range
    99. For Each Zelle In Tabelle1.UsedRange
    100. Zelle.Value = Trim(Zelle.Value)
    101. Next Zelle
    102. End Sub
    103. Sub KompletteFunktion()
    104. SpaltenZusammenfuehren
    105. Sortieren
    106. SpalteKopieren
    107. UmwandelnInGrossBuchstaben
    108. LeerzeichenEntfernen
    109. DuplikateEntfernen
    110. DuplikateEntfernen
    111. SpalteLoeschen
    112. SpaltenAufteilen
    113. Columns("A:E").Select
    114. Range(Selection, Selection.End(xlToRight)).Select
    115. Cells.EntireColumn.AutoFit
    116. End Sub

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „TeamBob“ ()