Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
496to500
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
496to500
496to500
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

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

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

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige