Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Doppelte Zeilen löschen

Doppelte Zeilen löschen
01.10.2012 16:02:06
Chris
Hallo zusammen,
ich brauche Hilfe bei folgendem Problem:
Eine Liste, die jeden Tag neu generiert wird, soll sortiert und ausgemistet werden.
Die Liste wird zuerst nach Eingangsdatum (Spalte J) der Produkte sortiert und dann nach einer Box-Nummer (Spalte I).
Jetzt, nach dem zusammen ist was zusammen gehört, soll diese Liste vereinfacht werden.
Da es Produkte gibt welche dieselbe Box-Nummer haben, sollen die Zeilen in denen dies der Fall ist, zusammen gefügt werden. Also quasi die wichtigen Daten in dafür vorgesehene leere Zellen nach oben eintragen und die Untere Zeile löschen.
Ich hoffe ich konnte mein Problem einigermaßen rüberbringen und danke euch schon mal für die Hilfe. :)
Grüße Chris

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Doppelte Zeilen löschen
01.10.2012 23:57:14
fcs
Hallo Chris,
hier eine Beispiel-Datei mit einem entsprechenden Makro, das du bezüglich der Spalten, deren Werte in die Zielspalten übertragen werden sollen, noch anpassen musst.
Gruß
Franz
https://www.herber.de/bbs/user/81950.xlsm
Sub BereinigenListe()
Dim wks As Worksheet, arrBox(), arrErledigt() As Boolean
Dim Zeile_L As Long, Zeile As Long, Zeile2 As Long, Treffer As Integer
Dim SpalteZiel1 As Long, SpalteZiel2 As Long, bolGeloescht As Boolean
Dim varBox As Variant
If MsgBox("Liste im aktiven Tabellenblatt bereinigen?", vbQuestion + vbOKCancel, _
"Liste bereinigen") = vbCancel Then Exit Sub
Set wks = ActiveSheet
With wks
'Letzte Datenzeile in Datumsspalte
Zeile_L = .Cells(.Rows.Count, 10).End(xlUp).Row
'1. Daten sortieren
With .Range(.Rows(1), .Rows(Zeile_L))
.Sort key1:=.Range("J1"), Order1:=xlDescending, _
key2:=.Range("I2"), Order2:=xlAscending, Header:=xlYes ' ggf. - anpassen!!
End With
'Daten aus Box-Spalte (I) in Arrayeinlesen
arrBox = .Range(.Cells(1, 9), .Cells(Zeile_L, 9))
'Array für erledigte Zeilen anlegen
ReDim arrErledigt(1 To Zeile_L)
'Zielspalten für doppelte Box-Zeilen vorgeben
SpalteZiel1 = 11 'Spalte K - Zielspalte für 1. Wert   - anpassen!!
SpalteZiel2 = 12 'Spalte L - Zielspalte für 2. Wert   - anpassen!!
With Application
.ScreenUpdating = False
End With
'Boxen in Spalte I abarbeiten
For Zeile = 2 To Zeile_L - 1
varBox = arrBox(Zeile, 1)
If arrErledigt(Zeile) = False Then
arrErledigt(Zeile) = True
Treffer = 0
'Nach doppelten Einträgen für Box suchen
For Zeile2 = Zeile + 1 To Zeile_L
If arrBox(Zeile2, 1) = varBox Then
If Treffer = 0 Then
'Wert aus Spalte 1 (A) in 1. Zeile übertragen
.Cells(Zeile, SpalteZiel1).Value = .Cells(Zeile2, 1).Text ' ggf. - anpassen!!
'Wert aus Spalte 5 (E) in 1. Zeile übertragen
.Cells(Zeile, SpalteZiel2).Value = .Cells(Zeile2, 5).Text ' ggf. - anpassen!!
Else
With .Cells(Zeile, SpalteZiel1)
.Value = .Value & Chr(10) & wks.Cells(Zeile2, 1).Text ' ggf. - anpassen!!
End With
With .Cells(Zeile, SpalteZiel2)
.Value = .Value & Chr(10) & wks.Cells(Zeile2, 5).Text ' ggf. - anpassen!!
End With
End If
'doppelte Box-Zeile löschen
.Rows(Zeile2).ClearContents
arrErledigt(Zeile2) = True
Treffer = Treffer + 1
bolGeloescht = True
End If
Next Zeile2
End If
Next Zeile
If bolGeloescht = True Then
'Leerzeilen löschen
.Range(.Cells(2, 10), _
.Cells(Zeile_L, 10)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End If
With Application
.ScreenUpdating = True
End With
End With
Erase arrBox, arrErledigt
End Sub

Anzeige
AW: Doppelte Zeilen löschen
02.10.2012 15:19:03
Chris
Hallo Franz,
super!!! Funktioniert einwandfrei!
Vielen Dank.
Grüße Chris

313 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige