BITTE Hilfe bei Makro! Bestimmte Zeilen löschen

Forumthread: BITTE Hilfe bei Makro! Bestimmte Zeilen löschen

Micha

Hallo liebe Spezialisten.
Ich suche ein Makro, welches mir nur die Zeilen mit dem Start und Enddatum anzeigt.
Alle übrigen Spalten sollen gelöscht werden.
Eine Beispieldatei befindet sich im Dateianhang.
Beschreibung befindet sich im Kommentar A2
https://www.herber.de/bbs/user/80018.xls
Ich hoffe sehr dass Ihr mir helfen könnt.
Danke Micha

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Bestimmte Zeilen löschen

02.05.2012 16:07:31

Erich

Hi Micha,
probier mal:


Option Explicit
Sub Makro1()
Dim lngZ As Long, zz As Long, rngDel As Range
Cells(2, 6).FormulaArray = _
"=D2+ROW(D2)%%=MIN(IF($A$2:$A$14&$B$2:$B$14=$A2&$B2,D$2:D$14+ROW(D$2:D$14)%%))"
Cells(2, 7).FormulaArray = _
"=E2+ROW(E2)%%=MAX(IF($A$2:$A$14&$B$2:$B$14=$A2&$B2,E$2:E$14+ROW(E$2:E$14)%%))"
lngZ = Cells(Rows.Count, 4).End(xlUp).Row
Range("F2:G2").Copy Range("F3:G" & lngZ)
For zz = 2 To lngZ
If Cells(zz, 6) Or Cells(zz, 7) Then
Else
If rngDel Is Nothing Then
Set rngDel = Cells(zz, 1)
Else
Set rngDel = Union(rngDel, Cells(zz, 1))
End If
End If
Next zz
If Not rngDel Is Nothing Then rngDel.EntireRow.Delete
End Sub

Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Ergänzung

02.05.2012 16:11:16

Erich

Hi Micha,
ein
Columns("F:G").ClearContents
am Ende des Codes könnte nicht schaden...
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

AW: Ergänzung

02.05.2012 16:21:35

Micha

Hi Erich,
Super, funktioniert soweit Prima.
Mal schauen wie ich das jetzt noch auf die Original Datentabelle umgestrubbelt hinbekomme.
Kannst Du den Code eventuell noch kommentieren, damit ich etwas lerne?
1.000 Dank und liebe Grüße
Micha

konkrete Fragen?

02.05.2012 18:32:16

Erich

Hi,
danke für deine Rückmeldung!
Der Code ist IMHO eigentlich schon sehr kurz und sprechend.
Sicher könnte ich einige Kommentare reinschreiben, wüsste dabei aber nicht, ob das etwas bringt.
Ich kenne deine Voraussetzungen nicht. Was ist dir eh schon klar, was nicht?
Wie ist es z. B. mit den Excel-Matrix-Formeln in F:G?
Gern versuche ich, einzelne konkrete Fragen zum Code zu beantworten, die du mir stellst. :-)
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

AW: konkrete Fragen?

04.05.2012 07:43:49

Micha

Hallo Erich,
vielen Dank für Deine Hilfe.
Ich habe mich inzwischen ein wenig in das Thema Matrixformeln eingelesen.
Ich habe noch eine große Bitte.
Ist es möglich das nur in einer Zeile der früheste Start und das späteste Ende angezeigt werden?
An der Beispieldatei würde sollte das Ergebnis dann so aussehen:
Tabelle1

	A	B	C	D	E
1	Vorher
2
3	Auftrag Nr.1	Auftrag Nr.2	Text	Start	Ende
4	222222	80000	Nur mal so	01.02.2012	02.02.2012
5	222222	80000	Test	01.02.2012	03.02.2012
6	222222	80000	Hallo	02.02.2012	04.02.2012
7	222222	80000	Test2	03.02.2012	05.02.2012
8	222222	80000	Stefan	02.02.2012	07.02.2012
9	222222	9999	Mario	01.02.2012	02.02.2012
10	222222	9999	Müller	01.02.2012	03.02.2012
11	222222	9999	Kurt	02.02.2012	04.02.2012
12	12345	22222	Start	01.04.2012	02.04.2012
13	12345	22222	Löschen	02.04.2012	03.04.2012
14	12345	22222	Löschen	03.04.2012	04.04.2012
15	12345	22222	Löschen	04.04.2012	05.04.2012
16	12345	22222	Ende	05.04.2012	06.04.2012
17
18
19	Nachher
20
21	Auftrag Nr.1	Auftrag Nr.2	Text	Start	Ende
22	222222	80000	Nur mal so	01.02.2012	07.02.2012
23	222222	9999	Mario	01.02.2012	04.02.2012
24	12345	22222	Start	01.04.2012	06.04.2012
25
26

Tabellendarstellung in Foren Version 5.47

Würde mich riesig freuen wenn du mir noch einmal helfen könntest!
Besten Gruß
Micha

neues Makro mit Dictionary

04.05.2012 11:33:20

Erich

Hi Micha,
nur eine kleine(?) Änderung in der Aufgabenstellung - und eine große in der Prozedur.
Probier mal:


Option Explicit
Sub MinMax()
Dim oDic As Object, arQ, zz As Long, strK As String, arZ, ii As Long
Set oDic = CreateObject("Scripting.Dictionary")
arQ = ActiveSheet.Cells(1, 1).CurrentRegion
For zz = 2 To UBound(arQ)
strK = arQ(zz, 1) & "|" & arQ(zz, 2)      ' Key aus Sp. A und B
If oDic.Exists(strK) Then
arZ = oDic(strK)                       ' bisherige Werte
' Min/Max prüfen
If arZ(4) > arQ(zz, 4) Then arZ(3) = arQ(zz, 3): arZ(4) = arQ(zz, 4)
If arZ(5)

Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

AW: neues Makro mit Dictionary

04.05.2012 13:25:05

Micha

Hallo Erich,
"Du bist GENIAL" ich finde es super nett das Du Dir so viel Mühe mit mir machst:-)
Funktioniert bis auf zwei (hoffentlich Kleinigkeiten) fast Perfekt:
1. Ich habe in der Originaldatei rechts der Spalte 5 noch weitere Spalten (50) die nicht gelöscht werden dürfen.
2. Klappt das auch ohne die Formatierungen zu löschen (ist aber nicht so wichtig wie Punkt 1)
1.000 Dank und ganz viele Grüße
Micha

AW: neues Makro mit Dictionary

04.05.2012 14:23:36

Erich

Hi Micha,
danke für deine Rückmeldung!
Deine beiden Punkte kannst du auf einen Schlag erledigen, indem du die Zeile mit dem Clear
ersetzt durch diese:
Cells(2, 1).Resize(UBound(arQ), 5).ClearContents ' lösche Altdaten
(Das mit den Formaten hatte ich nur drin, weil die Schriftfarbe teilweise rot ist.)
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

AW: neues Makro mit Dictionary

07.05.2012 12:43:25

Micha

Hallo Erich,
Super, jetzt ist es Perfekt :-)
Ganz toll, welche Mühe Du dir, mit mir, gegeben hast.
Nochmal vieeelen Dank und nette Grüße
Micha

Beliebteste Forumthreads (12 Monate)

BITTE Hilfe bei Makro! Bestimmte Zeilen löschen

Forumthread: BITTE Hilfe bei Makro! Bestimmte Zeilen löschen

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

BITTE Hilfe bei Makro! Bestimmte Zeilen löschen

Forumthread: BITTE Hilfe bei Makro! Bestimmte Zeilen löschen

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread