Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 23:47:55
Datum ausweisen, wenn definierte Summe erreicht ist
25.04.2024 21:40:53
Excel Datenquelle aus dem Web mit Anmeldung?
25.04.2024 21:21:16
Zellkommentar in UserForm anzeigen und bearbeiten
25.04.2024 21:13:13
Kalenderwochen addieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
808to812
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
808to812
808to812
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Bitte um Code-Verbesserung

Bitte um Code-Verbesserung
07.10.2006 12:48:55
Bernd
Hallo allerseits,
könnte jmd. bitte mal über folgenden Code, welchen ich mir dank dem Makrorekorder und diesem Forum zurecht gefummelt habe, und Verbesserungsvorschläge machen.
Bin für wirklich jeden Hinweis dankbar.
Zum Programm selbst: eine Liste wird nacheinander nach drei Gruppen gefilter, und jeweils untereinander in ein Blatt Meldungen eingefügt. Dabei sollen keine Leerzeilen entstehen.
----------------------------C-O-D-E-----------------------------------------
' Schaltet das Zeigen des Programmaufblaufes auf dem Bildschirm aus
Application.ScreenUpdating = False
' Sortiert Liste nach DG (Wertung)
Columns("A:I").Sort Key1:=Range("I2"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
' Filtert Liste nach aktuellen Abwesenheiten.
Sheets("Gesamtliste").Select
Selection.AutoFilter Field:=7, Criteria1:="Aktuell"
' Beseitgt im Blatt "Meldung" alle verbundenen Zellen
Sheets("Meldung").Select
Dim Zelle As Range
For Each Zelle In ActiveSheet.UsedRange
If Zelle.MergeCells Then
Zelle.UnMerge
End If
Next Zelle
' Löscht den Inhalt des Blattes "Meldung"
Sheets("Meldung").Cells.ClearContents
' Fügt oberen Teil der Meldung ein
Sheets("Legende").Select
Range("Meldung_oberer_Teil").Select
Selection.Copy
Sheets("Meldung").Select
Range("A1").Select
ActiveSheet.Paste
' Fügt Überschrift von Gruppe1 ein
Sheets("Legende").Select
Range("Überschrift_Gruppe1").Select
Selection.Copy
Sheets("Meldung").Select
Range("A20").Select
ActiveSheet.Paste
' Filtert Liste nach Gruppe1 und fügt gefilterte Liste in Blatt "Meldung" ein.
Sheets("Gesamtliste").Select
Selection.AutoFilter Field:=8, Criteria1:="Gruppe1"
With ActiveWorkbook
.Worksheets("Gesamtliste").Range("A2:C30001").Copy
Destination:=.Worksheets("Meldung").Range("A21")
End With
With ActiveWorkbook
.Worksheets("Gesamtliste").Range("E2:F30001").Copy _
Destination:=.Worksheets("Meldung").Range("D21")
End With
' Fügt Überschrift Gruppe2 ein
Sheets("Legende").Select
Range("Überschrift_Gruppe2").Select
Selection.Copy
Sheets("Meldung").Select
Range("A221").Select
ActiveSheet.Paste
' Filtert Liste nach Gruppe2 und fügt gefilterte Liste in Blatt "Meldung" ein.
Sheets("Gesamtliste").Select
Selection.AutoFilter Field:=8, Criteria1:="Gruppe2"
With ActiveWorkbook
.Worksheets("Gesamtliste").Range("A2:C30001").Copy _
Destination:=.Worksheets("Meldung").Range("A222")
End With
With ActiveWorkbook
.Worksheets("Gesamtliste").Range("E2:F30001").Copy _
Destination:=.Worksheets("Meldung").Range("D222")
End With
' Fügt Überschrift Gruppe3 ein
Sheets("Legende").Select
Range("Überschrift_Gruppe3").Select
Selection.Copy
Sheets("Meldung").Select
Range("A422").Select
ActiveSheet.Paste
' Filtert Liste nach Gruppe3 und fügt gefilterte Liste in Blatt "Meldung" ein.
Sheets("Gesamtliste").Select
Selection.AutoFilter Field:=8, Criteria1:="Gruppe3"
With ActiveWorkbook
.Worksheets("Gesamtliste").Range("A2:C30001").Copy _
Destination:=.Worksheets("Meldung").Range("A423")
End With
With ActiveWorkbook
.Worksheets("Gesamtliste").Range("E2:F30001").Copy _
Destination:=.Worksheets("Meldung").Range("D423")
End With
' Hebt sämtliche Filterungen auf.
Sheets("Gesamtliste").Select
Selection.AutoFilter Field:=8
Selection.AutoFilter Field:=7
Range("A1").Select
' Löscht die Leerzeilen in Tabelle "Meldung"
Sheets("Meldung").Select
With Range("A1:A65000")
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
Range("A1").Select
' Gibt Messagebox aus
MsgBox "Meldung erstellt!"
End Sub
----------------------------E-N-D-E-----------------------------------------
Gruss
Bernd

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

Betreff
Datum
Anwender
Anzeige
AW: Bitte um Code-Verbesserung
07.10.2006 13:13:40
Reinhard
Hi Bernd,
ungetstet:
Option Explicit
Sub tt()
Dim Zelle As Range, wsG As Worksheet, wsL As Worksheet
On Error GoTo Fehler
Set wsG = Worksheets("Gesamtliste")
Set wsL = Worksheets("Legende")
' Schaltet das Zeigen des Programmaufblaufes auf dem Bildschirm aus
Application.ScreenUpdating = False
' Sortiert Liste nach DG (Wertung)
Columns("A:I").Sort Key1:=Range("I2"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
' Filtert Liste nach aktuellen Abwesenheiten.
wsG.AutoFilter Field:=7, Criteria1:="Aktuell"
With Sheets("Meldung")
' Beseitgt im Blatt "Meldung" alle verbundenen Zellen
For Each Zelle In .UsedRange
If Zelle.MergeCells Then Zelle.UnMerge
Next Zelle
' Löscht den Inhalt des Blattes "Meldung"
.Cells.ClearContents
' Fügt oberen Teil der Meldung ein
wsL.Range("Meldung_oberer_Teil").Copy Destination:=.Range("A1")
' Fügt Überschrift von Gruppe1 ein
wsL.Range("Überschrift_Gruppe1").Copy Destination:=.Range("A20")
' Filtert Liste nach Gruppe1 und fügt gefilterte Liste in Blatt "Meldung" ein.
wsG.AutoFilter Field:=8, Criteria1:="Gruppe1"
wsG.Range("A2:C30001").Copy Destination:=.Range("A21")
wsG.Range("E2:F30001").Copy Destination:=.Range("D21")
' Fügt Überschrift Gruppe2 ein
wsL.Range("Überschrift_Gruppe2").Copy Destination:=.Range("A221")
' Filtert Liste nach Gruppe2 und fügt gefilterte Liste in Blatt "Meldung" ein.
wsG.AutoFilter Field:=8, Criteria1:="Gruppe2"
With ActiveWorkbook
.WorkwsG.Range("A2:C30001").Copy _
Destination:=.Worksheets("Meldung").Range("A222")
End With
With ActiveWorkbook
.WorkwsG.Range("E2:F30001").Copy _
Destination:=.Worksheets("Meldung").Range("D222")
End With
' Fügt Überschrift Gruppe3 ein
wsL.Range("Überschrift_Gruppe3").Copy Destination:=.Range("A422")
' Filtert Liste nach Gruppe3 und fügt gefilterte Liste in Blatt "Meldung" ein.
wsG.AutoFilter Field:=8, Criteria1:="Gruppe3"
wsG.Range("A2:C30001").Copy Destination:=.Range("A423")
wsG.Range("E2:F30001").Copy Destination:=.Range("D423")
' Hebt sämtliche Filterungen auf.
wsG.AutoFilter Field:=8
wsG.AutoFilter Field:=7
' Löscht die Leerzeilen in Tabelle "Meldung"
.Range("A1:A65000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
.Range("A1").Select
' Gibt Messagebox aus
MsgBox "Meldung erstellt!"
End With
Fehler:
Application.ScreenUpdating = True
End Sub

Gruß
Reinhard
ps: Ich freue mich über eine Rückmeldung ob diese Antwort hilfreich war oder nicht..
Anzeige
AW: Bitte um Code-Verbesserung
07.10.2006 13:37:41
Daniel
Hallo
vorab kleine bitte, bevor du den Code abschickst, füge bitte iher im Forumseditor am Code-Anfang ein "Sub xxx()" ein.
Wenn am Anfang "Sub" steht, erkennt der Edior, daß es sich um Code handelt, und
- Wechselt die Schriftart in Courier
- Behält die Einrückungen am Textanfang bei
Dadurch behält der Code seine Strukturierung und ist leichter lesbar.
Zu den Verbesserungen:
Sieht gar nicht so schlecht aus. Funktioniert der Code den wie gewünscht und du willst nur deinen Stil verbessern oder gibt es noch Funktionsprobleme?
- Du solltest nur noch konsequenter die ganzen Selects entfernen. Überall wo steht:
"objekt.SELECT
SELECTION.anweisung"
kann man auch direkt schreiben "objekt.anweisung"
- das Voranstellen von "Activeworkbook" kann normalerweise entfallen, da es defaultmäßig eingestellt ist.
Sheets("Tabelle1") bringt genau das gleiche Ergebnis wie activeworkbook.Sheets("Tabelle1").
das voranstellen des Workbooks ist nur erforderlich, wenn du dich auf ein Workbook beziehst, daß gerade nicht aktiv ist.
- die With-Anweisung ist dann sinnvoll, wenn du dich mehrfach hintereinander auf das gleiche Objekt beziehst, also statt
Sheets("Gesamtliste").Select
Selection.AutoFilter Field:=8
Selection.AutoFilter Field:=7
Range("A1").Select
schriebst du
with sheets("Gesamtliste").range("A1")
.autofilter Field: = 8
.autofilter field: = 7
end with
Willst du das Objekt nur einmal ansprechen, ist WITH überflüssig.
- das lückenlose Aneinanderkopieren erreichst du mit:
copy .... destination:=Sheets("xxx").range("A65000").end(xlup).offset(1,0)
(Namen und Spalten entsprechend anpassen)
Ansonsten fällt mir gerade nicht auf, aber ich lass die Frage mal offen, falls jemanden noch was einfällt.
Gruß, Daniel
Anzeige

Links zu Excel-Dialogen

MessageBox

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige