Live-Forum - Die aktuellen Beiträge
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
808to812
808to812
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Excel reagiert bei folgemdem Makro nicht mehr

Excel reagiert bei folgemdem Makro nicht mehr
10.10.2006 12:10:06
Bernd
Hallo,
ich habe das Problem, dass Excel bei folgendem Makro gar nicht mehr reagiert, d.h. sich komplett aufhängt.
Kann jemand helfen?
Gruss
Bernd

Sub daten_übertragen()
' Schaltet das Zeigen des Programmaufblaufes auf dem Bildschirm aus
Application.ScreenUpdating = False
' 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
' Sortiert Liste (Gesamtliste) nach Spalte DG
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").Range("A1").AutoFilter Field:=7, Criteria1:="Aktuell"
' Löscht den Inhalt des Blattes "Meldung"
Sheets("Meldung").Cells.ClearContents
' Fügt oberen Teil der Meldung ein
Sheets("Legende").Range("Meldung_oberer_Teil").Copy _
Destination:=Sheets("Meldung").Range("A65000").End(xlUp).Offset(1, 0)
' Fügt Überschrift Gruppe1 ein
Sheets("Legende").Range("Überschrift_Gruppe1").Copy _
Destination:=Sheets("Meldung").Range("A65000").End(xlUp).Offset(1, 0)
' Ergänzung w/ Fehler der Deaktivierung von verschmelzten Zellen:
With Sheets("Meldung").Range("A65000").End(xlUp).Range("A1:E1")
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
' Filtert Liste nach Gruppe1 und fügt gefilterte Liste in Blatt "Meldung" nahtlos an
Sheets("Gesamtliste").Range("A1").AutoFilter Field:=8, Criteria1:="Gruppe1"
Sheets("Gesamtliste").Range("A2:E30001").Copy _
Destination:=Sheets("Meldung").Range("A65000").End(xlUp).Offset(1, 0)
' Fügt Überschrift Gruppe2 ein
Sheets("Legende").Range("Überschrift_Gruppe2").Copy _
Destination:=Sheets("Meldung").Range("A65000").End(xlUp).Offset(1, 0)
' Ergänzung w/ Fehler der Deaktivierung von verschmelzten Zellen:
With Sheets("Meldung").Range("A65000").End(xlUp).Range("A1:E1")
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
' Filtert Liste nach Gruppe2 und fügt gefilterte Liste in Blatt "Meldung"  nahtlos an
Sheets("Gesamtliste").Range("A1").AutoFilter Field:=8, Criteria1:="Gruppe2"
Sheets("Gesamtliste").Range("A2:E30001").Copy _
Destination:=Sheets("Meldung").Range("A65000").End(xlUp).Offset(1, 0)
' Fügt Überschrift Gruppe3 ein
Sheets("Legende").Range("Überschrift_Gruppe3").Copy _
Destination:=Sheets("Meldung").Range("A65000").End(xlUp).Offset(1, 0)
' Ergänzung w/ Fehler der Deaktivierung von verschmelzten Zellen:
With Sheets("Meldung").Range("A65000").End(xlUp).Range("A1:E1")
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
' Filtert Liste nach Gruppe3 und fügt gefilterte Liste in Blatt "Meldung"  nahtlos an
Sheets("Gesamtliste").Range("A1").AutoFilter Field:=8, Criteria1:="Gruppe3"
Sheets("Gesamtliste").Range("A2:E30001").Copy _
Destination:=Sheets("Meldung").Range("A65000").End(xlUp).Offset(1, 0)
' Fügt Überschrift Langzeit ein
Sheets("Legende").Range("Überschrift_Langzeit").Copy _
Destination:=Sheets("Meldung").Range("A65000").End(xlUp).Offset(1, 0)
' Filtert Liste nach Langzeit und fügt gefilterte Liste in Blatt "Meldung"  nahtlos an
Sheets("Gesamtliste").Range("A1").AutoFilter Field:=8, Criteria1:="Langzeit"
Sheets("Gesamtliste").Range("A2:E30001").Copy _
Destination:=Sheets("Meldung").Range("A65000").End(xlUp).Offset(1, 0)
' Fügt unteren Teil der Meldung ein
Sheets("Legende").Range("Meldung_unterer_Teil").Copy _
Destination:=Sheets("Meldung").Range("A65000").End(xlUp).Offset(1, 0)
' Ergänzung w/ Fehler der Deaktivierung von verschmelzten Zellen:
With Sheets("Meldung").Range("A65000").End(xlUp).Range("A1:E1")
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
' Fügt Rahmen in der Meldung ein
Sheets("Meldung").Range("A14:E14").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Borders.LineStyle = xlContinuous
' Hebt sämtliche Filterungen auf.
Sheets("Gesamtliste").Range("A1").AutoFilter Field:=7
Sheets("Gesamtliste").Range("A1").AutoFilter Field:=8
' Gibt Messagebox aus
MsgBox "Meldung für gewünschten Tag erstellt!"
End Sub

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Excel reagiert bei folgemdem Makro nicht mehr
10.10.2006 12:19:22
Reinhard
Hi Bernd,
gehe in den Editor, stelle den Cursor in den Code und drücke F8 mehrmals bis der Fehler kommt. Dann auf "debuggen", sage dann die Fehlernummer und die Beschreibung und die zeile die gelb markiert ist, wandere dann mit dem Cursor über die Variablen dieser Zeile, welche Variablen haben welche Inhalte, Fehler,...
Zusätzlich kannst du auch eine klaeine Beispieldatei hochladen wo der Fehler auftritt.
Gruß
Reinhard
ps: Ich freue mich über eine Rückmeldung ob diese Antwort hilfreich war oder nicht..
AW: Excel reagiert bei folgemdem Makro nicht mehr
10.10.2006 12:40:30
Bernd
Gut,
wenn ich das mache, dann läuft alles sauber durch bis zu dem Punkt:
Sheets("Meldung").Range("A14:E14").Select
Fehler: 1004, Die Selectmethode des Range-Objekts konnte nicht ausgeführt werden
Gruss
b.
Anzeige
Ergänzung
10.10.2006 12:49:56
Bernd
Hallo Reinhard,
folgende Ergänzung von mir:
wenn ich den Code wie folgt umschreibe, scheint alles zu funktionieren:

Sub Rahmen_Auszug()
' Fügt Rahmen in der Meldung ein:
Sheets("Meldung").Select
Range("A14:E14").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Borders.LineStyle = xlContinuous
End Sub

Aber das muss doch auch noch kürzer (professioneller) gehen, oder?
Übrigens: hierbei scheint es sich um einen Nebenfehler zu handeln, denn das Aufhängen kann ich schon umgehen, indem ich den Codebestandteil der Entfernung von verbundenen Zellen herausnehme. Der scheint nämlich der Übeltäter zu sein.
Gruss
bernd
Gruss
bernd
Anzeige
AW: Ergänzung
10.10.2006 14:09:25
Rudi
Hallo,
With Sheets("Meldung")
.Range(.Cells(14, 1), .Cells(14, 1).End(xlDown).Offset(0, 4)).Borders.LineStyle = xlContinuous
End With
Gruß
Rudi
AW: Ergänzung
10.10.2006 14:16:28
paula
hi

Sub rahmen()
Dim c As Range
Sheets("Meldung").Select
Range("A14:E14").Select
For Each c In Range("A14:E14")
'jede zelle im bereich A14:E14 bekommt einen Rahmen
c.Borders.LineStyle = xlContinuous
Next c
End Sub

Rückmeldung nicht vergessen
Gruss paula
AW: Ergänzung
10.10.2006 17:54:10
Bernd
und was ist daran jetzt besser?
AW: Ergänzung
11.10.2006 16:04:31
Bertram
Hi Bernd,
du schreibst, dass
1.
Sheets("Meldung").Range("A14:E14").Select
nicht funktioniert, aber
2.
Sheets("Meldung").Select
Range("A14:E14").Select
funktioniert.
Grund:
Wenn du deinen Code startest, ist Sheets("Meldungen") nicht das aktive Blatt, deswegen schlägt die Select-Methode bei 1. fehl.
Bei 2. wird seperat selected, d.h. hintereinander geht's, aber nicht in einem Schritt.
Deshalb ist es in den meisten Fällen besser auf Select zu verzichten.
Gruß
Bertram
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige