Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1340to1344
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
Inhaltsverzeichnis

Duplikate mit hilfe einer Makro Schleife löschen

Duplikate mit hilfe einer Makro Schleife löschen
13.12.2013 12:00:59
Matterhorn
Hi Leute ich schildere euch mal mein Problem.
Ich habe eine datenbank mit 3 spalten, einmal seriennummer, datum, bemerkung. die datensätze die drin stehen sind ungefähr so 50.000 und davon sind viele duplikate drin. die duplikate kann ich aber nicht einfach entfernen oder filtern. die sollen in abhängigkeit von der seriennummer, der bemerkung und den datum entfernt werden.
beim datum soll aber folgendermaßen vorgegangen werden. es sollen nur die duplikate gelöscht werden deren datum jünger ist als 14 tage des ersten eintrags der folgenden seriennummer. wenn die gleiche seriennummer mit der gleichen bemerkung ein datum hat das älter ist als 14 tage des ersten eintrages der seriennummer wird dieser eintrag nicht gelöscht. das duplikat das älter ist als 14 tage gilt dann als neuer standpunkt. von dem eintrag an werden dann wieder alle einträge gelöscht die älter als 14 tage sind und dann geht das gleiche wie vorher beschrieben wieder weiter alle 14 tage. um euch zu zeigen was ich meine habe ich ein beispiel angehängt. ich hoffe ihr versteht was ich meine und könnt mir helfen das mit einem makro zu lösen. ich habe das problem bis jetzt anders gelöst aber die treffsicherheit war nur bei 70%.
bei meinem beispiel habe ich die bemerkungsspalte weggelassen weil die nicht so wichtig ist.
Ich habe vergessen ins bild zu schreiben das zeile 10 mit der begründung die da steht auch gelöscht werden soll
Hier ein Beispiel:
Userbild

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Duplikate mit hilfe einer Makro Schleife löschen
13.12.2013 12:36:34
UweD
Hallo
Die Daten und die Beschreibung passen doch nicht zusammen oder?
Erster Eintrag 14.11
der 19.11. soll stehen bleiben weil größer als erster Eintrag plus 14
14.11 plus 14 ist aber der 28.11. Das wäre der erste der stehen bleibt.
berichtige mal deine Daten.

AW: Duplikate mit hilfe einer Makro Schleife löschen
13.12.2013 13:05:55
UweD
Hallo nochmal
Nach der Beschreibung dürften nur folgende Zeilen stehen bleiben

10133080071	2013-11-14  02:51:52
10133080071	2013-11-28  02:51:52
10133080071	2013-12-22  02:51:52
10133080071	2014-01-15  02:51:52
Dann kannst du das Makro verwenden

Sub Zeilen_weg()
On Error GoTo Fehler
Dim i%, Erster As Date
Dim SP%, ZE&, LR&
ZE = 4 'Erste Zeile mit Daten
With ActiveSheet
LR = .Cells(Rows.Count, 1).End(xlUp).Row 'letzte Zeile der Spalte
Application.ScreenUpdating = False
Erster = .Cells(ZE, 2)
For i = ZE + 1 To LR
If .Cells(i, 1) = .Cells(i - 1, 1) Then
If .Cells(i, 2).Value  0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear
End Sub
Gruß UweD

Anzeige
AW: Duplikate mit hilfe einer Makro Schleife löschen
13.12.2013 13:25:22
Matterhorn
Stimmt du hast recht tut mir leid für den fehler. ich habe es nochmal aktualisiert. aber so wie du es oben schon beschrieben hast stimmt es. es bleiben nur die vier datensätze stehen.
aktualiserit
Userbild

AW: Duplikate mit hilfe einer Makro Schleife löschen
13.12.2013 14:05:24
Matterhorn
Ich habe es gerade getestet und glaube das es geht. tausend danke =D
:-***********************
i love you =)

AW: Duplikate mit hilfe einer Makro Schleife löschen
13.12.2013 14:13:32
Matterhorn
Aber eine Frage hätte ich noch woher weiß das makro wo das jahr der tag und monat und sogar die uhrzeit steht?

AW: Duplikate mit hilfe einer Makro Schleife löschen
13.12.2013 14:22:25
UweD
Hallo nochmal
Ich bin davon ausgegangen, dass es so wie angegeben in einer Zelle in SpalteB steht, die als Datum formatiert ist. (z.B. JJJJ-MM-TT hh:mm:ss)
Dabei ist völlig egal wierum das Datum geschrieben steht (01.01.2013 ... oder 2013-01-01...).
Excel rechnet immer intern mit einer Zahl, beginnend ab 01.01.1900 = 1
Gruß UweD

Anzeige
AW: Duplikate mit hilfe einer Makro Schleife löschen
16.12.2013 11:27:48
Matterhorn
Uwe die schleife funktioniert zwar aber excel stirbt bei mehr als 500 zeilen =(. was kann ich na da tun

AW: Duplikate mit hilfe einer Makro Schleife löschen
16.12.2013 11:56:00
Matterhorn
Ich verstehe es nicht ich habe 350.000 zeilen ich gehe auf duplikate entfernen dann sind es nur noch 1390 danach nehme ich das makro her und er filtert den rest. wenn ich habe bevor ich das makro anmache die zeilen nach dem datum sortieren lase von z.b. 01.01.2013 bis zum 01.09.2013 schmiert er ab sortiere ich aber von 01.09.2013 bis 01.01.2013 ist er in 2 sec fertig

AW: Duplikate mit hilfe einer Makro Schleife löschen
16.12.2013 13:46:29
UweD
Hallo
bei 350.000 Zeilen ist die Variable i, die als Integer dimensioniert ist. = max 32.767
falsch.
Muss als long dimensioniert werden.
Dim i&

Dauert aber lange.
Gruß UweD

Anzeige
AW: Duplikate mit hilfe einer Makro Schleife löschen
16.12.2013 23:22:17
Nico_von_Matter
Das i zu klein ist habe ich schon herausgefunden. Aber er hängt sich schon bei nur 200 auf aber nur wenn ich das datum sortiere.

AW: Duplikate mit hilfe einer Makro Schleife löschen
17.12.2013 08:35:50
UweD
Hallo
also bei mir klappt es sowohl sortiert als auch gemischt.
https://www.herber.de/bbs/user/88542.xlsm
Dann musst du mal eine Datei mit originaldaten hochladen
Gruß UweD

AW: Duplikate mit hilfe einer Makro Schleife löschen
17.12.2013 08:48:14
Matterhorn
Uwe hast du skype? ich darf das vll hier nicht hochladen das ist was firmen internes

AW: Duplikate mit hilfe einer Makro Schleife löschen
17.12.2013 09:39:23
UweD
schick mal an udem (at) gmx.net

AW: Duplikate mit hilfe einer Makro Schleife löschen
19.12.2013 14:35:26
UweD
Hallo
es hat lange gedauert, aber ich meine ich hab es jetzt.
1)
Ich hab mich nur auf meinen Teil konzentriert.
----------------------------------------------------
Option Explicit
Sub Refresh_Data()
'Aktualisierung der Pivot Tabelle "Simos 18 Pcs."
On Error GoTo Fehler
Dim Erster As Date
Dim SP%, ZE&, LR&
Dim i&
Dim stCalc&
With Application
.ScreenUpdating = False
stCalc = .Calculation
.Calculation = xlCalculationManual
End With
Sheets("External Data").Select
Range("B22").Select
'Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
Sheets("External Data").Activate
Range("B23, E23").Select
Do Until IsEmpty(ActiveCell)
If ActiveCell.Offset(1, 0).Value = ActiveCell.Value Then
ActiveCell.Offset(1, 0).EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
Range("B23:B5000,E23:E5000,I23:I5000,K23:K5000").Select
Range("K23").Activate
Selection.Copy
Sheets("1. Cache").Select
Cells(65000, 2).End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWorkbook.Worksheets("1. Cache").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("1. Cache").AutoFilter.Sort.SortFields.Add Key:= _
Range("C3"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("1. Cache").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'- - - - UweD
SP = 2 'Spalte mit Daten
ZE = 4 'Erste Zeile mit Daten
With ActiveSheet
LR = .Cells(Rows.Count, SP).End(xlUp).Row 'letzte Zeile der Spalte
Erster = CDate(.Cells(ZE, SP + 1))
For i = ZE + 1 To LR
If .Cells(i, SP) = .Cells(i - 1, SP) Then
If CDate(.Cells(i, SP + 1).Value) = LR Then GoTo Weiter
Else
Erster = CDate(.Cells(i, SP + 1).Value)
End If
Next
End With
Weiter:
'- - - - UweD
'alle Spalten von B bis G "1.Cache" nach "Main Memory" kopieren
Range("B4:G50000").Select
Range("G4").Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("Main Memory").Select
Cells(65000, 2).End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Range("$B$3:$H$20000").AutoFilter Field:=7, Criteria1:=Array( _
"Abt. 137 FT Analyse", "Auflegen", "Auflegen AEMI NTF loeschen", "freischalten", _
"FT Analyse", "Handling", "PDI pruefen", "="), Operator:=xlFilterValues
Range("B4:E20000").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("LEO DB").Select
Range("B16").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Main Memory").Select
ActiveSheet.Range("$B$3:$H$20000").AutoFilter Field:=7
Sheets("LEO DB").Select
Range("L16:N20000").Select
Application.CutCopyMode = False
Selection.Copy
Range("F16").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Analysis Statistic").Select
Err.Clear
Fehler:
If Err.Number  0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear
With Application
.ScreenUpdating = True
.Calculation = stCalc
End With
End Sub

----------------------------------------------------
einige Ursachen waren.
- du verwendest Spalte ab B und nicht ab A
- du hast meinen Teil in ein Anderes eingebaut.
die Sprungstelle "Exit Sub" funktionierte damit nicht und hab ich geändert

If i >= LR Then GoTo Weiter

- Datum lag als Text vor (übersetze ich nun in ein richtiges Datum)
- .....
----------------------------------------------------
2)
- Ausstellen der automatischen Calkulation bei jeder Zelländerung bringt auch einiges an Zeitgewinn
(wird zum Schluss wieder auf die ursprüngliche Einstellung zurückgesetzt)
--------------------------------------------------
3)
- Du verwendest in deinem Teil sehr oft .select und .activate
- Das kann in den meisten Fällen wegfallen.
>> Wenn du für weitere Operationen nicht tatsächlich in einem bestimmten Blatt in einer Zelle stehen musst, um eine Aktion auszulösen
- auch in dem anderen Modul
Aus:
Range("B23:B5000,E23:E5000,I23:I5000,K23:K5000").Select
Range("K23").Activate
Selection.Copy

kann z.B. werden:
Range("B23:B5000,E23:E5000,I23:I5000,K23:K5000").Copy

dadurch wird der Ablauf ebenfalls viel schneller
----------------------------------------------------
Ich hoffe ich konnte dir helfen
Gruß und Frohes Fest
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige