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

Forumthread: zeilen löschen wenn

zeilen löschen wenn
19.05.2024 19:42:43
Said
Hallo Profis,
Ich brauche Eure F1 (Hilfe):

Ich will ein Macro bei dem: alle Zeilen, in deren Spalte J (wichtig: Spalte J und nicht A) nicht der Begriff „ Metzger“ steht, gelöscht werden. D. h es bleiben dann nur die Zeilen, in deren Spalte J das Wort „Metzger“ steht.

Vielen Dank im Voraus.

PS: von Exce-Programmierung verstehe ich etwas mehr als die Kuh von Eier legen aber nicht viel mehr. Bette bei Euren Kommentare oder Fragen es beachten.

Anzeige

52
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: zeilen löschen wenn
19.05.2024 20:01:22
daniel
Hi

Schreibe ans Tabellenende in die erste freie Spalte eine Formel, die die 0 ausgibt, wenn die Zeile gelöscht werden soll und die Zeilennummern, wenn die Zeile stehen bleiben soll. =wenn(J1="Metzger";Zeile();0)

Schreibe in die überschriftenzeile dieser Spalte die 0

Wende dann den Mebübefehl: Daten - Datentools - Duplikate entfernen an, mit der neuen Spalte als Kriterium und der Option, keine Überschrift

Zum Schluss die neue Spalte wieder löschen.

Mit Hilfe des Recorders sollte sich diese Abfolge Recht einfach in ein VBA-Makro umschreiben lassen.

Ansonsten sollten sich Beispielcodes in den Forenarchiven finden lassen .


Anzeige
AW: zeilen löschen wenn
19.05.2024 20:14:45
Oppawinni
VBA code...


Sub unit()
Dim wks As Worksheet
Dim rngUsed As Range
Dim lngFirstRow As Long, lngLastRow As Long, i As Long

Set wks = ActiveSheet
Set rngUsed = wks.UsedRange
lngFirstRow = rngUsed.Row
lngLastRow = rngUsed.Rows(rngUsed.Rows.Count).Row
For i = lngLastRow To lngFirstRow Step -1
If UCase(wks.Cells(i, "J").Value) > "METZGER" Then
wks.Rows(i).Delete
End If
Next
End Sub
Anzeige
AW: zeilen löschen wenn
19.05.2024 21:04:15
Said
Lieber Oppawinni,
vielen Dank erstmal für Deine Mühe und es funktioniert einwandfrei mit "METZGER".
Erstzte ich aber METZGER durch "Becker" dam löscht er alle Zeilen, Warum?
"Metzger" war nur als Beispiel. in Wirklichkeit sind die Begriffe anders ( "Fahrdienst", "Ladendienst" "Fundus", "Emphang")
Außerdem würdest Du bitte die Zeile 1-3 ausnehmen (Alle Zeilen außer 1-3 die in Spalte J nicht "Fahrdienst" steht)
vielen Dank und wenn ich könnte hätte ich Dich zu einem oder mehrern Bier eingeladen :-)
LG
Anzeige
AW: zeilen löschen wenn
19.05.2024 21:17:02
Oppawinni
Naja, du siehst, dass ich METZGER geschrieben habe, also in Großbuchstaben.
Ich vergleiche nämlich mit dem in Großbuchstaben gewandelten Inhalt der Zelle. Das macht diese UCase( .. )
Du müsstest im Code also "FAHRDIENST" angeben, damit die entsprechenden Zeilen erhalten bleiben, oder eben UCase( .. ) raus werfen und mit "Fahrdienst" vergleichen.
Dann würden halt Zeilen mit FAHRDIENST oder FahrDienst usw. auch raus geworfen.
Damit Zeilen 1 bis 3 erhalten bleiben...
Sub unit()

Dim wks As Worksheet
Dim rngUsed As Range
Dim lngFirstRow As Long, lngLastRow As Long, i As Long

Set wks = ActiveSheet
Set rngUsed = wks.UsedRange
lngFirstRow = WorksheetFunction.Max(4, rngUsed.Row)
lngLastRow = WorksheetFunction.Max(4, rngUsed.Rows(rngUsed.Rows.Count).Row)
For i = lngLastRow To lngFirstRow Step -1
If UCase(wks.Cells(i, "J").Value) > "FAHRDIENST" Then
wks.Rows(i).Delete
End If
Next
End Sub
Anzeige
AW: zeilen löschen wenn
19.05.2024 21:41:05
Said
funktioniert einwandfrei! Die Zeilen 1-3 (Überschriften) bleiben auch erhalten, Du hast mir sehr geholfen.
vielen vielen vielen vielen....... und noch tausand mal, lieben Dank.
viele liebe Grüße
Said
AW: De rien...
19.05.2024 21:46:02
Oppawinni
Nicht der Rede wert.
AW: De rien...
21.05.2024 21:18:26
Said
Lieber Oppawinni,
wie gesagt, Dein Makro, was ich in meinem Program oft verwendet habe, funktioniert tadellos. Wie Du wahrscheinlich gemerkt hast, das ist für einen gemeinnützigen Verein, wo ich ehrenamtlich mitwirke.
Jetzt eine neue Frage: kannst Du zusätzlich ein andres Makro kreieren, wobei: wenn 6 Zellen hintereinander in einer Spalte leer sind (Spalte egal z. B. A), sollen die Zeilen gelöscht werden. Oder die restlichen Zeilen sollen gelöscht werden (von mir aus auch bis Zeile xxx z. B. bis Zeile 612).
Ist so etwas möglich?

(Wenn Zelle Leer, Zeile löschen) reicht nicht sondern es sollen genau 6 Zellen hintereinander leer sein, und somit sollen diese oder die restlichen Zeilen gelöscht werden.

Grund warum 6 Zellen:
In der Zelle in Spalte A steht ein Name und weitere 5 Zelen in dieser Spalte sind leer (weil in andere Spalten bis 6 Zellen gebraucht werden). Am Ende der Tabelle (z. B. Ladenliste) sind mehrere Zeilen, die ich in Program formatiert habe und in diesen Zellen steht nicht außer die leere Rahmen. Beim Asudrucken werden dann x Seiten mit nur leeren Rahmen mitausgerdruckt :-( und das ist nicht schön und auch nicht sinnvoll.

LG
Anzeige
AW: De rien...
21.05.2024 22:09:52
Oppawinni
Wenn ich das richtig verstehe, dann ist das fast das gleiche nur einfacher:



Sub unit()
Dim wks As Worksheet
Dim rngUsed As Range
Dim lngFirstRow As Long, lngLastRow As Long, i As Long

Set wks = ActiveSheet
Set rngUsed = wks.UsedRange
lngFirstRow = wks.Cells(wks.Rows.Count, "A").End(xlUp).Row + 7
lngLastRow = WorksheetFunction.Max(4, rngUsed.Rows(rngUsed.Rows.Count).Row)
For i = lngLastRow To lngFirstRow Step -1
wks.Rows(i).Delete
Next
End Sub
Anzeige
AW: De rien...
21.05.2024 23:25:08
Said
vielen Dank,
morgen werde ich ausprobieren und sage dann Bescheid.
Mit Sicherheit wird es funktionieren und wenn nicht, dann liegt es bestimmt an Mir. Auf jeden Fall sage ich Bescheid.
Noch mal herzlichen Dank und viele liebe Grüße
Said
AW: De rien...
22.05.2024 08:20:52
Said
Lieber Oppawinni,
ein kleines Problem: Im meiem Makro kommt Zwei mal "Dim wks As Worksheet" vor, daher mecker er und geht nicht weiter :-( kann bei zweiten mal etwas andreres als "wks..." eingeben. Hier mein kompelltes Makro für "Laden":

Sub Laden()
'
' Laden Makro
'

'Kopieren und einfügen:
Sheets(" Übersicht Mitglieder").Select
Cells.Select
Selection.Copy
Sheets("Laden").Select
Cells.Select
ActiveSheet.Paste

' Alle Zeile außer "Ladendienst in Spalte J löschen:
Dim wks As Worksheet
Dim rngUsed As Range
Dim lngFirstRow As Long, lngLastRow As Long, i As Long

Set wks = ActiveSheet
Set rngUsed = wks.UsedRange
lngFirstRow = WorksheetFunction.Max(4, rngUsed.Row)
lngLastRow = WorksheetFunction.Max(4, rngUsed.Rows(rngUsed.Rows.Count).Row)
For i = lngLastRow To lngFirstRow Step -1
If UCase(wks.Cells(i, "J").Value) > "LADENDIENST" Then
wks.Rows(i).Delete
End If
Next

' Sortieren A-Z:
Rows("4:123").Select
ActiveWorkbook.Worksheets("Laden").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Laden").Sort.SortFields.Add Key:=Range("A4"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Laden").Sort
.SetRange Range("A4:AM123")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

' Zwischenkopieren:

Rows("4:70").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ZML").Select
Rows("4:70").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Kopiereen in der Seite Ladenliste:
Sheets("L").Select
Rows("7:300").Select
Selection.Copy
Sheets("Ladenliste").Select
Rows("7:300").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

' leere Zeilen löschen:
Dim wks As Worksheet
Dim rngUsed As Range
Dim lngFirstRow As Long, lngLastRow As Long, i As Long

Set wks = ActiveSheet
Set rngUsed = wks.UsedRange
lngFirstRow = wks.Cells(wks.Rows.Count, "A").End(xlUp).Row + 7
lngLastRow = WorksheetFunction.Max(4, rngUsed.Rows(rngUsed.Rows.Count).Row)
For i = lngLastRow To lngFirstRow Step -1
wks.Rows(i).Delete
Next


End Sub

viele liebe Grüße
Said
Anzeige
AW: De rien...
22.05.2024 13:24:48
Said
Lieber Oppawinni,
leider hat es nicht funtioniert und wie gesagt liegt es an mir. Zum Testzwecke habe ich ein einfaches Testmakro geschrieben, So:

Sub Makro2()
'
' Makro2 Makro
'

'
Sheets("Ladenliste").Select


' Zeilen löchrn
Dim wks As Worksheet
Dim rngUsed As Range
Dim lngFirstRow As Long, lngLastRow As Long, i As Long

Set wks = ActiveSheet
Set rngUsed = wks.UsedRange
lngFirstRow = wks.Cells(wks.Rows.Count, "A").End(xlUp).Row + 7
lngLastRow = WorksheetFunction.Max(4, rngUsed.Rows(rngUsed.Rows.Count).Row)
For i = lngLastRow To lngFirstRow Step -1
wks.Rows(i).Delete
Next

Dabei ist mir aufgefallen, dass es 5 Zelle in Spalte A sind, die leer sind (nicht 6). soll ich aus ".... +7 " +6 machen? und was ist mit 4 in "4, rngUsed...."?
soll man sost etwas ändern?
LG

Anzeige
AW: De rien...
22.05.2024 13:42:03
Oppawinni
Du brauchst dieses
Sheets("Ladenliste").Select
nicht, ersetzte
Set wks = ActiveSheet
durch
Set wks = Sheets("Ladenliste")
Die 4 war wegen deines Titels, aber man sollte das vielleicht einfach so machen:


lngFirstRow = wks.Cells(wks.Rows.Count, "A").End(xlUp).Row + 6
lngLastRow = WorksheetFunction.Max(lngFirstRow, rngUsed.Rows(rngUsed.Rows.Count).Row)

damit die Nummer der letzten Zeile nicht kleiner wird, als die der Ersten.
Und ja, mit der 6 steuerst du den Zeilenabstand zum letzten Eintrag in Spalte A

Das müsste in deinem "großen" Makro dann auch funktionieren.
Ich hab da ActiveSheet rein geschrieben, weil ich ja nicht weiß, welche Worksheets du da hast bzw. ansprechen willst.
Wenn zufällig das richtige selectiert ist, würde das ja auch funktionieren.
Aber - wie gesagt - man braucht das Select nicht, wenn man ein konkretes Worksheet statt ActiveSheet anspricht.
Anzeige
AW: De rien...
22.05.2024 14:06:29
Said
bestem Dank. Ich probiere es heute Abend und sage dann auf jeden Fall Bescheid (wird jetzt bestimmt funktionieren).
LG
AW: De rien...
22.05.2024 23:28:27
Said
Leider funktioniert bei mir irgendwie nicht :-(

so habe ich eingegeben:
Sub unit()
Dim wks As Worksheet
Dim rngUsed As Range
Dim lngFirstRow As Long, lngLastRow As Long, i As Long

Set wks = Sheets("Ladenliste")
Set rngUsed = wks.UsedRange
lngFirstRow = wks.Cells(wks.Rows.Count, "A").End(xlUp).Row + 5
lngLastRow = WorksheetFunction.Max(lngFirstRow, rngUsed.Rows(rngUsed.Rows.Count).Row)
For i = lngLastRow To lngFirstRow Step -1
wks.Rows(i).Delete
Next

End Sub
In meiner Test-Datei habe ich nur der Register "Ladenliste"
Am Ende der Tabelle steht:
Spalte A Spalte B Spalte C
.
.
.
Muster Musterman Straße Nr. Ladendienst
leere Zelle 503xx Stadt Fahrdiens mölich
leer Zelle Tel: 0221xxx
Leer Zelle Mobil:0177xx
Leer Zelle E-Mail:
Leer (wegen Abstand ) leer leer

danach sind viele Blocke (, die ich gelöscht haben will) mit:
Spalte A Spalte B Spalte C
0 0 0
leer 0 0
leer 0 0
Leer 0 0
Leer 0 0
Leer

allerdingst wird auf Seite (per Einstellung Anzeige) die Zellen mit 0 nicht angezeigt. gelten sie auch als Leer?
Der Unterschied zwischen die Blocke, die ich gelöscht haben will und die Blocke, die ich behalten will, ist dass in deren Spalte A ein 0 steht, die nicht angezeigt wird und bei blocke, die ich behalten will ein Name also Text.
Hast Du vielleicht andere Idee, wie man diese Blocke löschen kann.
LG


Anzeige
AW: De rien...
22.05.2024 23:40:02
Oppawinni
Da wäre es wohl am Besten, wenn ich eine Beispieldatei hätte.
Sonst drehen wir und nur wieder im Kreis...
AW: De rien...
23.05.2024 06:49:22
Said
sehr gerne hätte ich Dir die Datei geschickt. Ich habe auch überlegt, dass ich Dir die komplette Datei schicke (natürlich als Datenschutzgründen ohne persönliche Daten)
Ich wüsste aber nicht wie. hier geht anscheinend nicht.
Dein letztes Makro hat aber super geklappt. Du hast sogar "blind" das Problem gelöst. und das ist ja unglaublich! Prima hoch hundert!
LG
Said
Anzeige
AW: De rien...
23.05.2024 00:11:10
Oppawinni
Du kannst vielleicht das noch probieren:


Sub unit()
Dim wks As Worksheet
Dim rngUsed As Range
Dim lngFirstRow As Long, lngLastRow As Long, i As Long

Set wks = ThisWorkbook.Worksheets("Ladenliste")
Set rngUsed = wks.UsedRange

lngFirstRow = wks.Cells(wks.Rows.Count, "A").End(xlUp).Row
While IsNumeric(wks.Cells(lngFirstRow, "A").Value) And lngFirstRow > 3
lngFirstRow = wks.Cells(lngFirstRow, "A").End(xlUp).Row
Wend
lngFirstRow = lngFirstRow + 6
lngLastRow = WorksheetFunction.Max(lngFirstRow, rngUsed.Rows(rngUsed.Rows.Count).Row)
For i = lngLastRow To lngFirstRow Step -1
wks.Rows(i).Delete
Next
End Sub
Anzeige
AW: De rien...
23.05.2024 06:40:00
Said
Wou......!
das hat super funktioniert, einwandfrei und in Anhieb. Die Ausführung des Makro dauert zwar sehr lange aber das macht überhabt nicht. Das Ergebnis ist sauber und perfekt.
Wie gesagt das war eine Test-Tabelle, jetzt muss ich diese in meiner eigentliche Tabelle, Für „Ladenliste“, Fahrerliste“, „Fundusliste“… u.sw. anpassen und einbinden.
Ich danke Dir tausend Mal.
Viele liebe Grüße und hab einen schönen Tag
Said
Anzeige
AW: De rien...
23.05.2024 08:11:13
Oppawinni
Hast wohl ne Menge Zeug da hängen...
Naja, ok, das zeilenweise Löschen ist da suboptimal.
Da löschen wir besser en block:



Sub unit()
Dim wks As Worksheet
Dim rngUsed As Range
Dim lngFirstRow As Long, lngLastRow As Long, i As Long

Set wks = ThisWorkbook.Worksheets("Ladenliste")
Set rngUsed = wks.UsedRange

lngFirstRow = wks.Cells(wks.Rows.Count, "A").End(xlUp).Row
While IsNumeric(wks.Cells(lngFirstRow, "A").Value) And lngFirstRow > 3
lngFirstRow = wks.Cells(lngFirstRow, "A").End(xlUp).Row
Wend
lngFirstRow = lngFirstRow + 6
lngLastRow = WorksheetFunction.Max(lngFirstRow, rngUsed.Rows(rngUsed.Rows.Count).Row)
wks.Rows(lngFirstRow & ":" & lngLastRow).Delete
End Sub
Anzeige
AW: De rien...
23.05.2024 08:54:55
Said
Werde ich auf jeden ausprobieren.
Besteht eine Möglichkeit, dass ich Dir die komplette Datei schicke, wenn ich damit fertig bin. Nur wenn Du Zeit, Lust und Interesse hast. Vielleicht kannst Du sogar dann etwa optimieren. Das ist für eine gute Sache: siehe www.bruehlertsfel.de.
LG
AW: De rien...
23.05.2024 12:28:07
Said
Liebe Oppawinni,
hat viel besser funktioniert und ich habe in meiner Datei eingebaut und bin jetzt fertig. Bei der Tafel habe ich Excel 2019 und dort hat noch schneller (also ganz schnell, nur wenige Sekunden) funktioniert. :-) und darüber bin ich sehr, sehr froh. Daher ist mir, was der Freund "Daniel" schreibt irrelevant.
Wenn Du willst, schicke ich Dir die Datei, nur muss Du mir sagen wie.
Nur in einer Register "Geburtstagsliste" hat es nicht funktioniert, da dort die Spalte A anders aufgebaut ist (sortiert nach Geburtsdatum).
Viel herzliche Dank für Deine Mühe und Firma T... dankt Dir natürlich auch.
LG
Anzeige
AW: De rien...
23.05.2024 12:43:24
daniel
wenn die Beschreibung stimmt (Namen und Zahl 0 in der Spalte, Zeilen mit 0 löschen)
sollte das ganze über einen Einzeiler lösbar sein:

range("A:A").Specialcells(xlcelltypeconstants, 2).EntireRow.Delete


das ganze entspricht der Auswahl der zu löschenden Zellen über das Menü START - BEARBEITEN - SUCHEN UND AUSWÄHLWEN - INTHALTE ...
wozu dann der aufwendige Code? ist doch ein Anfänger, der sich mit Excel vielleicht ein bisschen besser auskennt als mit VBA.
Gruß Daniel
Anzeige
AW: De rien...
23.05.2024 12:36:43
Said
Hier das komplette Makro, Danke Deiner Hilfe Falls es Dich interessiert. (ich weiß, dass ich in diesen Gebiet ein Laie bin und nicht professionell gemacht habe aber bin ich sehr froh, dass ich trotzdem bis dahin (natürlich mit Deiner Hilfe) geschafft habe :-)


Sub Namensortieren()
'
' Namensortieren Makro
'

'
Sheets(" Übersicht Mitglieder").Select
Rows("4:204").Select
Selection.Copy
Sheets("ZM").Select
Rows("2:202").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("ZM").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("ZM").Sort.SortFields.Add Key:=Range("A2"), SortOn _
:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("ZM").Sort
.SetRange Rows("2:202")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With


' Kopiereen in der Seite Ladenliste:
Sheets("L").Select
Rows("7:606").Select
Selection.Copy
Sheets("Namenliste").Select
Rows("7:606").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

' Leere Zeilen löschen:
Set wks = ThisWorkbook.Worksheets("Namenliste")
Set rngUsed = wks.UsedRange

lngFirstRow = wks.Cells(wks.Rows.Count, "A").End(xlUp).Row
While IsNumeric(wks.Cells(lngFirstRow, "A").Value) And lngFirstRow > 3
lngFirstRow = wks.Cells(lngFirstRow, "A").End(xlUp).Row
Wend
lngFirstRow = lngFirstRow + 6
lngLastRow = WorksheetFunction.Max(lngFirstRow, rngUsed.Rows(rngUsed.Rows.Count).Row)
wks.Rows(lngFirstRow & ":" & lngLastRow).Delete

End Sub

Sub Passiv()
'
' Passiv Makro
'

'Kopieren und einfügen:
Sheets(" Übersicht Mitglieder").Select
Cells.Select
Selection.Copy
Sheets("Passiv").Select
Cells.Select
ActiveSheet.Paste

' Alle Zeile außer "Passiv"dienst in Spalte J löschen:
Dim wks As Worksheet
Dim rngUsed As Range
Dim lngFirstRow As Long, lngLastRow As Long, i As Long

Set wks = ActiveSheet
Set rngUsed = wks.UsedRange
lngFirstRow = WorksheetFunction.Max(4, rngUsed.Row)
lngLastRow = WorksheetFunction.Max(4, rngUsed.Rows(rngUsed.Rows.Count).Row)
For i = lngLastRow To lngFirstRow Step -1
If UCase(wks.Cells(i, "J").Value) > "PASSIV" Then
wks.Rows(i).Delete
End If
Next

' Sortieren A-Z:
Rows("4:35").Select
ActiveWorkbook.Worksheets("Fundus").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Fundus").Sort.SortFields.Add Key:=Range("A4"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Fundus").Sort
.SetRange Range("A4:AM123")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With


End Sub
Sub Fahrer()
'
' Fahrer Makro
'

'
'Kopieren und einfügen:
Sheets(" Übersicht Mitglieder").Select
Cells.Select
Selection.Copy
Sheets("Fahrer").Select
Cells.Select
ActiveSheet.Paste

' Alle Zeile außer "Fahrdienst" in Spalte J löschen:
Dim wks As Worksheet
Dim rngUsed As Range
Dim lngFirstRow As Long, lngLastRow As Long, i As Long

Set wks = ActiveSheet
Set rngUsed = wks.UsedRange
lngFirstRow = WorksheetFunction.Max(4, rngUsed.Row)
lngLastRow = WorksheetFunction.Max(4, rngUsed.Rows(rngUsed.Rows.Count).Row)
For i = lngLastRow To lngFirstRow Step -1
If UCase(wks.Cells(i, "J").Value) > "FAHRDIENST" Then
wks.Rows(i).Delete
End If
Next

' Sortieren A-Z:
Rows("4:35").Select
ActiveWorkbook.Worksheets("Fahrer").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Fahrer").Sort.SortFields.Add Key:=Range("A4"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Fahrer").Sort
.SetRange Range("A4:AM123")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

' Zwischenkopieren:

Rows("4:35").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ZMF").Select
Rows("4:35").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Kopiereen in der Seite Fahrerliste:
Sheets("F").Select
Rows("7:131").Select
Selection.Copy
Sheets("Fahrerliste").Select
Rows("7:131").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False


' Leere Zeilen löschen:
Set wks = ThisWorkbook.Worksheets("Fahrerliste")
Set rngUsed = wks.UsedRange

lngFirstRow = wks.Cells(wks.Rows.Count, "A").End(xlUp).Row
While IsNumeric(wks.Cells(lngFirstRow, "A").Value) And lngFirstRow > 3
lngFirstRow = wks.Cells(lngFirstRow, "A").End(xlUp).Row
Wend
lngFirstRow = lngFirstRow + 6
lngLastRow = WorksheetFunction.Max(lngFirstRow, rngUsed.Rows(rngUsed.Rows.Count).Row)
wks.Rows(lngFirstRow & ":" & lngLastRow).Delete

End Sub
Sub Fundus()
'
' Fundus Makro
'

'Kopieren und einfügen:
Sheets(" Übersicht Mitglieder").Select
Cells.Select
Selection.Copy
Sheets("Fundus").Select
Cells.Select
ActiveSheet.Paste

' Alle Zeile außer "Fundus"dienst in Spalte J löschen:
Dim wks As Worksheet
Dim rngUsed As Range
Dim lngFirstRow As Long, lngLastRow As Long, i As Long

Set wks = ActiveSheet
Set rngUsed = wks.UsedRange
lngFirstRow = WorksheetFunction.Max(4, rngUsed.Row)
lngLastRow = WorksheetFunction.Max(4, rngUsed.Rows(rngUsed.Rows.Count).Row)
For i = lngLastRow To lngFirstRow Step -1
If UCase(wks.Cells(i, "J").Value) > "FUNDUS" Then
wks.Rows(i).Delete
End If
Next

' Sortieren A-Z:
Rows("4:35").Select
ActiveWorkbook.Worksheets("Fundus").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Fundus").Sort.SortFields.Add Key:=Range("A4"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Fundus").Sort
.SetRange Range("A4:AM123")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

' Zwischenkopieren:

Rows("4:35").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ZMFU").Select
Rows("4:35").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Kopiereen in der Seite Fahrerliste:
Sheets("FU").Select
Rows("7:131").Select
Selection.Copy
Sheets("Fundusliste").Select
Rows("7:131").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

' Leere Zeilen löschen:
Set wks = ThisWorkbook.Worksheets("Fundusliste")
Set rngUsed = wks.UsedRange

lngFirstRow = wks.Cells(wks.Rows.Count, "A").End(xlUp).Row
While IsNumeric(wks.Cells(lngFirstRow, "A").Value) And lngFirstRow > 3
lngFirstRow = wks.Cells(lngFirstRow, "A").End(xlUp).Row
Wend
lngFirstRow = lngFirstRow + 6
lngLastRow = WorksheetFunction.Max(lngFirstRow, rngUsed.Rows(rngUsed.Rows.Count).Row)
wks.Rows(lngFirstRow & ":" & lngLastRow).Delete

End Sub
Sub Laden()
'
' Laden Makro
'

'Kopieren und einfügen:
Sheets(" Übersicht Mitglieder").Select
Cells.Select
Selection.Copy
Sheets("Laden").Select
Cells.Select
ActiveSheet.Paste

' Alle Zeile außer "Ladendienst in Spalte J löschen:
Dim wks As Worksheet
Dim rngUsed As Range
Dim lngFirstRow As Long, lngLastRow As Long, i As Long

Set wks = ActiveSheet
Set rngUsed = wks.UsedRange
lngFirstRow = WorksheetFunction.Max(4, rngUsed.Row)
lngLastRow = WorksheetFunction.Max(4, rngUsed.Rows(rngUsed.Rows.Count).Row)
For i = lngLastRow To lngFirstRow Step -1
If UCase(wks.Cells(i, "J").Value) > "LADENDIENST" Then
wks.Rows(i).Delete
End If
Next

' Sortieren A-Z:
Rows("4:123").Select
ActiveWorkbook.Worksheets("Laden").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Laden").Sort.SortFields.Add Key:=Range("A4"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Laden").Sort
.SetRange Range("A4:AM123")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

' Zwischenkopieren:

Rows("4:70").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ZML").Select
Rows("4:70").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Kopiereen in der Seite Ladenliste:
Sheets("L").Select
Rows("7:300").Select
Selection.Copy
Sheets("Ladenliste").Select
Rows("7:300").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

' Leere Zeilen löschen:
Set wks = ThisWorkbook.Worksheets("Ladenliste")
Set rngUsed = wks.UsedRange

lngFirstRow = wks.Cells(wks.Rows.Count, "A").End(xlUp).Row
While IsNumeric(wks.Cells(lngFirstRow, "A").Value) And lngFirstRow > 3
lngFirstRow = wks.Cells(lngFirstRow, "A").End(xlUp).Row
Wend
lngFirstRow = lngFirstRow + 6
lngLastRow = WorksheetFunction.Max(lngFirstRow, rngUsed.Rows(rngUsed.Rows.Count).Row)
wks.Rows(lngFirstRow & ":" & lngLastRow).Delete


End Sub


Sub Geburtstagsliste()
'
' Geburtstagsliste Makro
'

'

'Kopieren und einfügen:
Sheets(" Übersicht Mitglieder").Select
Cells.Select
Selection.Copy
Sheets("ZMG").Select
Cells.Select
ActiveSheet.Paste

Rows("4:125").Select
ActiveWindow.SmallScroll Down:=-117
ActiveWorkbook.Worksheets(" Übersicht Mitglieder").Sort.SortFields.Clear
ActiveWorkbook.Worksheets(" Übersicht Mitglieder").Sort.SortFields.Add Key:= _
Range("H4:H77"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets(" Übersicht Mitglieder").Sort.SortFields.Add Key:= _
Range("G4:G77"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets(" Übersicht Mitglieder").Sort
.SetRange Range("A4:AM77")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

' Kopiereen in der Seite Geb. Liste:
Sheets("g").Select
Rows("7:606").Select
Selection.Copy
Sheets("Geb. Liste").Select
Rows("7:606").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False


' Leere Zeilen löschen:



End Sub




Sub Ausblenden()
'
' Ausblenden Makro
'

'
Sheets("ZM").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("ZMG").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("N").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("G").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("F").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("ZMF").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("L").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("ZML").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("FU").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("ZMFU").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("Fundus").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("Laden").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("Fahrer").Select
ActiveWindow.SelectedSheets.Visible = False


End Sub
Sub Einblenden()
'
' Einblenden Makro
'

'
Sheets("Geb. Liste").Select
Sheets("ZM").Visible = True
Sheets("Geb. Liste").Select
Sheets("Geb. Liste").Select
Sheets("ZMG").Visible = True
Sheets("Geb. Liste").Select
Sheets("N").Visible = True
Sheets("Geb. Liste").Select
Sheets("G").Visible = True
Sheets("Geb. Liste").Select
Sheets("F").Visible = True
Sheets("ZMF").Visible = True
Sheets("L").Visible = True
Sheets("ZML").Visible = True
Sheets("FU").Visible = True
Sheets("ZMFU").Visible = True
Sheets("Laden").Visible = True
Sheets("Fahrer").Visible = True
Sheets("Fundus").Visible = True

End Sub
Sub TabellenErstellen()
'
' TabellenErstellen Makro
'
Call Einblenden
Call Namensortieren
Call Passiv
Call Fahrer
Call Fundus
Call Laden
Call Geburtstagsliste
Call Ausblenden

End Sub

Anzeige
AW: De rien...
23.05.2024 09:12:32
daniel
du hast noch eine andere Löschmethode beschrieben bekommen.
die ist bei großen Datenmengen wesentlich schneller.
hast du die mal ausprobiert?
Wahrscheinlich nicht, weil du dich da selber etwas hättest bemühen müssen, anstatt fertigen Code zu bekommen.
Gruß Daniel
AW: De rien...
23.05.2024 09:33:58
Oppawinni
Es ist schön, dass du dich dafür bewirbst, das "Endprodukt" für Excel 2007 zu optimieren, oder war das jetzt nicht deine Intension?
Anzeige
AW: De rien...
23.05.2024 09:38:50
Oppawinni
Intension ist ja auch ein schönes Wort, aber Intention wollte ich schreiben. Das Schmarrphon spuckt einem immer mal wieder in die Suppe..
AW: De rien...
23.05.2024 10:06:01
daniel
es sollte sich mittlerweile rumgesprochen haben, dass es seit Excel 2007 eine einfache und schnelle Methode zum Löschen von Zeilen auch in sehr großen Datenmengen gibt.
und auch für noch ältere Excelversionen gibt es einfache , die schneller sind als die meistens gezeigte einfache For-Next-Schleife.
den Code dafür habe ich hier schon sehr oft vorgestellt.
Gruß Daniel
Anzeige
AW: De rien...
23.05.2024 10:44:24
Oppawinni
Nicht um den Brei herum reden.
Willst du dich dem Thema annehmen, oder nicht?
AW: De rien...
23.05.2024 10:51:59
daniel
will ich und habe ich doch auch schon.
einfach mal die bereits vorhandenen Antworten lesen.
ich habe aber erstmal nur den manuellen Weg beschrieben, weil dich denke, dass man diesen auch mit wenig VBA-kenntnissen mit hilfe des Recorders in ein funktionsfähiges Makro überführen kann.
wir wollen ja die Eigeninitiative fördern.

Gruß Daniel
Anzeige
AW: De rien...
23.05.2024 12:02:12
Oppawinni
Dir aber schon klar, dass du es mit einem Anfänger zu tun hast.
Da wünsche ich dann gutes Gelingen und bin hier raus.
AW: De rien...
23.05.2024 12:21:04
daniel
warum raus?
hast du dir das mal angeschaut?
willst du vielleicht nicht auch etwas dazu lernen, z.B. wie man in beliebig großen Exceltabellen schnell und einfach Zeilen löscht?

Anzeige
AW: De rien...
23.05.2024 12:47:10
Said
Lieber Daniel,
Ich bin mit dem, was mir "Oppawinni" empfohlen hat, sehr zufrieden. Es ist für unsere Zwecke professionell genug. Anderes wollte ich gar nicht haben, sonst wäre ich mit meinen Kenntnissen total überfördert. So funktioniert einwandfrei und ist auch bei Excel 2019 (Firma) ganz schnell und funktioniert einwandfrei.
Trotzdem danke ich Dir für Deinen Rat.
LG
Anzeige
AW: De rien...
23.05.2024 13:53:05
daniel
ok

wenn dir
Sub unit()

Dim wks As Worksheet
Dim rngUsed As Range
Dim lngFirstRow As Long, lngLastRow As Long, i As Long

Set wks = ThisWorkbook.Worksheets("Ladenliste")
Set rngUsed = wks.UsedRange

lngFirstRow = wks.Cells(wks.Rows.Count, "A").End(xlUp).Row
While IsNumeric(wks.Cells(lngFirstRow, "A").Value) And lngFirstRow > 3
lngFirstRow = wks.Cells(lngFirstRow, "A").End(xlUp).Row
Wend
lngFirstRow = lngFirstRow + 6
lngLastRow = WorksheetFunction.Max(lngFirstRow, rngUsed.Rows(rngUsed.Rows.Count).Row)
For i = lngLastRow To lngFirstRow Step -1
wks.Rows(i).Delete
Next
End Sub

besser gefällt als
sub xxx()

ThisWorkbook.Worksheets("Ladenliste").Columns(1).SpecialCells(xlcelltypeconstants, 1).entireRow.Delete
end Sub

dann wirst du mit meinen Lösungsansätzen nicht glücklich werden.

Anzeige
AW: De rien...
23.05.2024 14:07:22
Oppawinni
Jetzt nicht raus reden, mein Freund.
Da sind jetzt deine didaktischen Fähigkeiten gefragt.
Die musst du nicht an mir üben.
AW: De rien...
23.05.2024 14:12:59
daniel
der Fragesteller hat schon meine erste Antwort ignoriert.
wenn jemand nicht will, hilft auch keine Didaktik.
AW: De rien...
23.05.2024 18:19:26
Said
Lieber Daniel,
Ich habe Deinen Sub xxx () in meiner Datei eingesetzt. Leider hat es nicht funktioniert (bei Durchführen wird die ganze Zeile gelb angezeigt). Das bedeutet nicht, dass es nicht richtig ist oder nicht funktionieren würde, sondern ich muss bestimmt in meiner Datei oder in übrigen Makroteilen einiges ändern und dazu fehlen mir leider die notwendigen Kenntnissen. Daher bleibe ich liebe bei der Version, die mir Oppawinni vorgeschlagen hat und tadenlos funktioniert.
Trodem danke ich Dir von ganzem Herzen für Deine Mühe und Deine Sorge.
viele liebe Grüße
Said
Anzeige
AW: De rien...
23.05.2024 18:26:32
daniel
sei so nett und lade mal die Datei mit Makro und Daten hoch.
AW: De rien...
23.05.2024 18:43:47
Said
alles klar, ich würde gerne von Anfang an machen, ich wusste nicht wie es geht aber jetzt sehe ich den Botten.
wie gesagt, ich bin ein Laie und die Datei so wie es ist, bin ich hoch zufrieden und auf keinen Fall will ich anderes haben (Professionell), da ich bei Problemen eingreifen muss und ich kenne nur „Kopie“ und „Paste“. Ich möchte nicht nachher im Regen stehen, weil ich mich mit Codes und andere Sachen nicht auskenne.
Aus Datenschutz Gründen muss ich die Daten löschen bzw. durch „Muster“ ersetzen danach lade ich sie hoch. In ca. halbe Stunde!
Said
Anzeige
AW: De rien...
23.05.2024 14:19:09
Oppawinni
Die hilft sehr wohl.
Du musst dich nur auf das Niveau des Schülers einstellen und darfst ihn nicht überfordern.
Und immerhin, du hast ein Danke für deinen Beitrag bekommen, also nochmal.
Viel Erfolg.
AW: De rien...
23.05.2024 18:23:52
Said
Lieber Daniel
Tut mir sehr leid. Um welche Frage geht es? ich muss bestimmt übersehen haben, sonst würde ich auf jeden Fall antworten.
aber wie gesagt, jetzt funktioniert alles und ich bin dank Euch sehr glücklich.
LG
Anzeige
AW: De rien...
23.05.2024 14:26:23
daniel
hier schein der Schüler aber schon mit dem Ausführen einfacher Menübefehle nach Anweisung überfordert gewesen zu sein.
um mal Kinski/Giermann zu zitieren: "so blöd kann keiner sein"
also scheint es doch eher der unwille zur eigenen Leistung zu sein.
Copy-Paste von Code ist ja auch viel einfacher.
Anzeige
AW: De rien...
23.05.2024 18:07:43
Oppawinni
Du glaubst es ja nicht, aber du hast damit bewiesen, dass du in gewisser Hinsicht eine ziemliche Niete bist...
AW: De rien...
23.05.2024 18:29:19
Said
Lieber Daniel,
Schön in meiem ersten Beitrag habe ich angegeben dass meine Kenntnisse in Excel-Programierung ist "so viel von Kuh vom Eier legen" vielleich geringfügig merh aber nich viel mehr!
Said
Anzeige
AW: De rien...
23.05.2024 18:22:59
daniel
ja. mag sein
aber ich muss ja nicht jedem den Arsch nachtragen.
Das kannst du gerne machen.

aber lerne erstmal Excel, SpecialCells und so.
AW: De rien...
23.05.2024 19:19:24
Said
habe die Datei hochgeladen.
AW: De rien...
23.05.2024 19:23:07
daniel
das alleine reicht nicht.
du musst auch den angezeigten Link kopieren und in deinen Beitrag einfügen, damit wir darauf zugreifen können.
steht das nicht in den Hinweisen beim hochladen?
Gruß Daniel
Anzeige
AW: De rien...
23.05.2024 18:45:19
Oppawinni
Der Spruch passt ins Bild....
aber perfekt
AW: De rien...
23.05.2024 20:21:33
Said
Lieber VOppawinni,
die Datei habe ich hochgeladen : https://www.herber.de/bbs/
wie gesagt die Zeilen in Geb. Liste könnte ich mit Makro nicht löschen, da die Spalte A anderes ist als bei anderen Listen. Also das Makro dafür muss entsprechen etws geändert werden.
Ich bin von Deinen Vorschläge begeistert. würdest Du da bitte nachschauen.
vielen Dank und LG
Said
Anzeige
AW: De rien...
24.05.2024 11:05:06
Said
Lieber Oppawinni, Lieber Daniel,
die Sache mit "Geb. Liste" hat sich erledigt. Ich habe das Problem so gelöst, dass ich die Spalte D zur Spalte A gebracht habe. Jetzt sind alle Seiten Identisch und funktionieren alle einwandfrei, schnell und gut. Besser kann und soll nicht sein. Sonst wäre ich überfördert gewesen. Danke nochmal für die gute Ratschläge und aktive Hilfe. Ich bin überglücklich.
Übrigens bei uns in der "Firma" bin ich der Einäugige, der König ist :-)
viele liebe Grüße und noch einmal tausend Dank
Said
Anzeige
AW: De rien...
22.05.2024 08:53:16
Oppawinni
Naja,
Das ist das Problem, wenn man Code zusammen kopiert.
In dem Fall ist es so, dass ich ja in beiden Fällen identische Variablennamen verwendet habe.
Um Variable verwenden zu können, muss man sie EINMAL vor der Verwendung anlegen. Das passiert mit DIM . ..
Ich gehe davon aus, dass du den zweiten identischen Block von DIM Anweisungen komplett entfernen musst, damit das funktioniert.
Anzeige
AW: zeilen löschen wenn
19.05.2024 21:42:43
Said
Und mein Angebot mit Bier steht immer noch :-)
Liebe Grüße
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige