Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
860to864
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
860to864
860to864
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Doppelte Zeilen löschen

Doppelte Zeilen löschen
15.04.2007 10:32:00
Andreas
Hallo,
wer kann mir bei meinem nächsten Problem helfen?
Die Tabelle sieht im Aufbau wie folgt aus:
Spalte A_______Spalte B_______Spalte C usw.
123A4567______1234A45678____01
999A8877______7584A98764____01
457B5317______5719A58742____01
457B5317______5719A58742____02
(________stehen für Leezeichen)
Die Werte in Zeile 3 und 4 sind in den Spalten A und B identisch. Lediglich in Spalte C unterscheiden sie sich. Wenn in der Spalte A zwei oder mehr identische Ordnungskriterien sind, dann sollen sämtliche doppelten Zeilen (egal was in der Spalte C und in den weiteren Spalten steht) gänzlich gelöscht werden (im Beispiel: Zeile 3 bleibt bestehen und Zeile 4 wird komplett gelöscht). Die berinigten Zeilen (um die doppelten) sollen dann in ein neues Tabellenblatt importiert werden. Das Ursprungstabellenblatt soll unverändert als Quelldatei bestehen bleiben. In diesem Zusammenhang wäre es für mich auch sehr hilfreich, wenn beim Löschen der doppelten Zeilen etwaig vorkommende Leezeilen gleich mit gelöscht werden. Ich hoffe, ich habe mein Problem/meine Frage konkret genug gestellt.
Gruß und Danke
Andreas

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Doppelte Zeilen löschen
15.04.2007 10:58:00
Josef
Hallo Andreas,
probier mal.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub kopieren()
Dim objSh1 As Worksheet, objSh2 As Worksheet
Dim rng As Range, rngF As Range, r As Range
Dim lngR As Long

On Error GoTo ErrExit
GMS

Set objSh1 = Sheets("Tabelle1")
Set objSh2 = Worksheets.Add(After:=Sheets(Sheets.Count))

objSh2.Name = Format(Now, "Li\s\te dd.mm.yy hh|mm|ss")

Set rng = objSh1.Range("A1:C" & objSh1.Cells(Rows.Count, 1).End(xlUp).Row)

For Each r In rng.Columns(1).Cells
    If Len(Trim(r)) > 0 Then
        Set rngF = objSh2.Range("A:A").Find(r, Lookat:=xlWhole)
        If rngF Is Nothing Then
            lngR = lngR + 1
            rng.Rows(r.Row).Copy objSh2.Rows(lngR)
        End If
    End If
Next


ErrExit:

GMS True
Set rng = Nothing
Set objSh1 = Nothing
Set objSh2 = Nothing

End Sub

Sub GMS(Optional ByVal Modus As Boolean = False)

With Application
    .ScreenUpdating = Modus
    .EnableEvents = Modus
    .DisplayAlerts = Modus
    .EnableCancelKey = IIf(Modus, 1, 0)
    .Calculation = IIf(Modus, -4105, -4135)
    .Cursor = IIf(Modus, -4143, 2)
End With

End Sub

Gruß Sepp

Anzeige
AW: Doppelte Zeilen löschen
15.04.2007 13:55:00
Andreas
Hallo Sepp,
vielen Dank für Deine Hilfestellung. Es hat funktioniert.
Gruß und bis demnächst
Andreas

AW: Doppelte Zeilen löschen
15.04.2007 14:08:20
Daniel
Hallo
soll jetzt für das Löschen nur nach Spalte A gesucht werden oder auch nach Spalte B?
wenns nur Spalte A ist, dann so:

Sub ZeilenWeg1()
activesheet.copy after:=activeworkbook.ActiveSheet
Columns(1).Insert
With Range("A2:A" & Cells(65536, 2).End(xlUp).Row)
.FormulaR1C1 = "=IF(or(COUNTIF(R1C2:RC2,RC2)>1,RC2=""""),TRUE,ROW())"
.Formula = .Value
.CurrentRegion.Sort key1:=Range("A2"), order1:=xlAscending, header:=xlyes
.SpecialCells(xlCellTypeConstants, 4).EntireRow.Delete
.EntireColumn.Delete
End With
End Sub


Gruß, Daniel

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige