Live-Forum - Die aktuellen Beiträge
Datum
Titel
16.10.2025 11:16:26
SUMMEWENN erweitern
16.10.2025 09:40:53
Mehrere Konferenzen ohne Personenüberschneidung terminieren
16.10.2025 00:15:51
Passwort im Herbersforum ändern
15.10.2025 16:22:17
Datum ist nicht Datum :(
Keine passende Antwort im Forumarchiv gefunden?
Stelle deine Frage im Live-Forum
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
496to500
496to500
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Makro vereinfachen

Forumthread: Makro vereinfachen

Makro vereinfachen
11.10.2004 09:52:47
Hanno
Hallo Leute,
ich habe unten angehängte Makros geschrieben. Sie unterscheiden sich nur in einzelnen Variablen.
Nun meine Frage: Kann man diese Makros nicht zusammenfassen, so dass ich nur ein Makro ausführen muss? Ich kenne mich da leider nicht so gut aus.
Vielen Dank im Voraus,
Hanno

Sub NachMontagenSortieren()
Dim rng As Range
Dim lngE As Long 'für letzte gefüllte Zeile
Dim lngRow As Long 'Zeilenzähler in "OH"
lngRow = 1
'Letzte gefüllte Zelle in Spalte "C" ermitteln
lngE = IIf(IsEmpty(Sheets("Data2").Range("C65536")), Sheets("Data2").Range("C65536").End(xlUp).Row, 65536)
Sheets("Mo").Columns("a").ClearContents
Sheets("Mo").Columns("b").ClearContents
Sheets("Mo").Columns("c").ClearContents
Sheets("Mo").Columns("d").ClearContents
For Each rng In Sheets("Data2").Range("A1:A" & lngE)
If rng <> "" And rng = 2 Then
Sheets("Mo").Cells(lngRow, 1) = rng.Offset(0, 1)
Sheets("Mo").Cells(lngRow, 2) = rng.Offset(0, 2)
Sheets("Mo").Cells(lngRow, 3) = rng.Offset(0, 3)
Sheets("Mo").Cells(lngRow, 4) = rng.Offset(0, 4)
'Zeilenzähler erhöhen
lngRow = lngRow + 1
End If
Next
End Sub



Sub NachDienstagenSortieren()
Dim rng As Range
Dim lngE As Long 'für letzte gefüllte Zeile
Dim lngRow As Long 'Zeilenzähler in "OH"
lngRow = 1
'Letzte gefüllte Zelle in Spalte "C" ermitteln
lngE = IIf(IsEmpty(Sheets("Data2").Range("C65536")), Sheets("Data2").Range("C65536").End(xlUp).Row, 65536)
Sheets("Di").Columns("a").ClearContents
Sheets("Di").Columns("b").ClearContents
Sheets("Di").Columns("c").ClearContents
Sheets("Di").Columns("d").ClearContents
For Each rng In Sheets("Data2").Range("A1:A" & lngE)
If rng <> "" And rng = 3 Then
Sheets("Di").Cells(lngRow, 1) = rng.Offset(0, 1)
Sheets("Di").Cells(lngRow, 2) = rng.Offset(0, 2)
Sheets("Di").Cells(lngRow, 3) = rng.Offset(0, 3)
Sheets("Di").Cells(lngRow, 4) = rng.Offset(0, 4)
'Zeilenzähler erhöhen
lngRow = lngRow + 1
End If
Next
End Sub



Sub NachMittwochenSortieren()
Dim rng As Range
Dim lngE As Long 'für letzte gefüllte Zeile
Dim lngRow As Long 'Zeilenzähler in "OH"
lngRow = 1
'Letzte gefüllte Zelle in Spalte "C" ermitteln
lngE = IIf(IsEmpty(Sheets("Data2").Range("C65536")), Sheets("Data2").Range("C65536").End(xlUp).Row, 65536)
Sheets("Mi").Columns("a").ClearContents
Sheets("Mi").Columns("b").ClearContents
Sheets("Mi").Columns("c").ClearContents
Sheets("Mi").Columns("d").ClearContents
For Each rng In Sheets("Data2").Range("A1:A" & lngE)
If rng <> "" And rng = 4 Then
Sheets("Mi").Cells(lngRow, 1) = rng.Offset(0, 1)
Sheets("Mi").Cells(lngRow, 2) = rng.Offset(0, 2)
Sheets("Mi").Cells(lngRow, 3) = rng.Offset(0, 3)
Sheets("Mi").Cells(lngRow, 4) = rng.Offset(0, 4)
'Zeilenzähler erhöhen
lngRow = lngRow + 1
End If
Next
End Sub



Sub NachDonnerstagenSortieren()
Dim rng As Range
Dim lngE As Long 'für letzte gefüllte Zeile
Dim lngRow As Long 'Zeilenzähler in "OH"
lngRow = 1
'Letzte gefüllte Zelle in Spalte "C" ermitteln
lngE = IIf(IsEmpty(Sheets("Data2").Range("C65536")), Sheets("Data2").Range("C65536").End(xlUp).Row, 65536)
Sheets("Do").Columns("a").ClearContents
Sheets("Do").Columns("b").ClearContents
Sheets("Do").Columns("c").ClearContents
Sheets("Do").Columns("d").ClearContents
For Each rng In Sheets("Data2").Range("A1:A" & lngE)
If rng <> "" And rng = 5 Then
Sheets("Do").Cells(lngRow, 1) = rng.Offset(0, 1)
Sheets("Do").Cells(lngRow, 2) = rng.Offset(0, 2)
Sheets("Do").Cells(lngRow, 3) = rng.Offset(0, 3)
Sheets("Do").Cells(lngRow, 4) = rng.Offset(0, 4)
'Zeilenzähler erhöhen
lngRow = lngRow + 1
End If
Next
End Sub



Sub NachFreitagenSortieren()
Dim rng As Range
Dim lngE As Long 'für letzte gefüllte Zeile
Dim lngRow As Long 'Zeilenzähler in "OH"
lngRow = 1
'Letzte gefüllte Zelle in Spalte "C" ermitteln
lngE = IIf(IsEmpty(Sheets("Data2").Range("C65536")), Sheets("Data2").Range("C65536").End(xlUp).Row, 65536)
Sheets("Fr").Columns("a").ClearContents
Sheets("Fr").Columns("b").ClearContents
Sheets("Fr").Columns("c").ClearContents
Sheets("Fr").Columns("d").ClearContents
For Each rng In Sheets("Data2").Range("A1:A" & lngE)
If rng <> "" And rng = 6 Then
Sheets("Fr").Cells(lngRow, 1) = rng.Offset(0, 1)
Sheets("Fr").Cells(lngRow, 2) = rng.Offset(0, 2)
Sheets("Fr").Cells(lngRow, 3) = rng.Offset(0, 3)
Sheets("Fr").Cells(lngRow, 4) = rng.Offset(0, 4)
'Zeilenzähler erhöhen
lngRow = lngRow + 1
End If
Next
End Sub



Sub NachFreitagenSortieren()
Dim rng As Range
Dim lngE As Long 'für letzte gefüllte Zeile
Dim lngRow As Long 'Zeilenzähler in "OH"
lngRow = 1
'Letzte gefüllte Zelle in Spalte "C" ermitteln
lngE = IIf(IsEmpty(Sheets("Data2").Range("C65536")), Sheets("Data2").Range("C65536").End(xlUp).Row, 65536)
Sheets("Fr").Columns("a").ClearContents
Sheets("Fr").Columns("b").ClearContents
Sheets("Fr").Columns("c").ClearContents
Sheets("Fr").Columns("d").ClearContents
For Each rng In Sheets("Data2").Range("A1:A" & lngE)
If rng <> "" And rng = 6 Then
Sheets("Fr").Cells(lngRow, 1) = rng.Offset(0, 1)
Sheets("Fr").Cells(lngRow, 2) = rng.Offset(0, 2)
Sheets("Fr").Cells(lngRow, 3) = rng.Offset(0, 3)
Sheets("Fr").Cells(lngRow, 4) = rng.Offset(0, 4)
'Zeilenzähler erhöhen
lngRow = lngRow + 1
End If
Next
End Sub

Anzeige

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro vereinfachen
Dr.
Stehen nur die Tage im Worksheet? Bzw. wo stehen die Bläter?
AW: Makro vereinfachen
EtoPHG
Hallo Hanno,
Vielleicht so ?
Option Explicit

Sub SortierenAufrufen()
Dim vX As Variant
Dim tTag As String
vX = InputBox("Bitte Tag eingeben:", "Sortiern nach")
If vX = vbCancel Then Exit Sub
tTag = vX
Call NachTagSortieren(tTag)
End Sub

Public 

Sub NachTagSortieren(tTag As String)
Dim rng As Range
Dim lngE As Long 'für letzte gefüllte Zeile
Dim lngRow As Long 'Zeilenzähler in "OH"
If Not (tTag = "Mo" Or _
tTag = "Di" Or _
tTag = "Mi" Or _
tTag = "Do" Or _
tTag = "Fr" Or _
tTag = "Sa" Or _
tTag = "So") Then
MsgBox "Input-Parameter entspricht keinem gültigem Wert!" & vbCrLf & _
"Gültig sind = Mo, Di, Mi, Do, Fr, Sa, So", vbOKOnly, "Parameter Test"
Exit Sub
End If
lngRow = 1
'Letzte gefüllte Zelle in Spalte "C" ermitteln
lngE = IIf(IsEmpty(Sheets("Data2").Range("C65536")), Sheets("Data2").Range("C65536").End(xlUp).Row, 65536)
Sheets(tTag).Columns("a").ClearContents
Sheets(tTag).Columns("b").ClearContents
Sheets(tTag).Columns("c").ClearContents
Sheets(tTag).Columns("d").ClearContents
For Each rng In Sheets("Data2").Range("A1:A" & lngE)
If rng <> "" And rng = 2 Then
Sheets(tTag).Cells(lngRow, 1) = rng.Offset(0, 1)
Sheets(tTag).Cells(lngRow, 2) = rng.Offset(0, 2)
Sheets(tTag).Cells(lngRow, 3) = rng.Offset(0, 3)
Sheets(tTag).Cells(lngRow, 4) = rng.Offset(0, 4)
'Zeilenzähler erhöhen
lngRow = lngRow + 1
End If
Next
End Sub

Gruss Hansueli
Anzeige
AW: Makro vereinfachen
11.10.2004 11:36:19
Hanno
Hallo Hansueli,
danke für Deine Hilfe!
Was bedeutet 'Options explicit' und 'Public' ?
Danke,
Hanno
AW: Makro vereinfachen
EtoPHG
Hallo Hanno,
Option Explicit bedeutet, dass Excel innerhalb des Codes keine impliziten Variable Deklarationen zulässt, d.h. Jede Variable muss mit einer DIM variablename datentyp
Anweisung deklariert sein.
Public Sub xxx() bedeutet, dass diese prozedur von allen anderen prozeduren im Projekt (Arbeitsmappe, Arbeitsblatt) angesprochen (Call xxx) werden kann.
Gruss Hansueli
Anzeige
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
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