Anzeige
Archiv - Navigation
1052to1056
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
Inhaltsverzeichnis

Makro Dauer zu lange

Makro Dauer zu lange
24.02.2009 06:36:44
Ludmila
Hallo,
kann mir jemand sagen warum nachfolgendes Makro ca. 30 sekunden benötigt!
Wo liegt der Fehler?
Danke!
Grß
Ludmila
Option Explicit

Sub Listen()
On Error Resume Next
Dim Datum1 As Variant
Dim I As Integer
Dim iRow As Integer
Dim iColumns As Integer
Dim Endrow As Integer
Dim TimeU As Double
Dim Datum As Date
Dim List As Integer
Datum1 = Sheets("Eingabe").Cells(1, 1).Value
Datum1 = Format(CDbl("dd.mm.yyyy"))
TimeU = 0.33333
Endrow = Sheets("Daten").Cells(Rows.Count, 1).End(xlUp).Row
For iRow = Endrow + 1 To Endrow + 41
iColumns = 1
With Sheets("Daten")
.Cells(iRow, iColumns).Value = Datum1
.Cells(iRow, iColumns + 1).Value = TimeU
End With
TimeU = TimeU + (1 / 24 / 4)
Next iRow
'Sheets("Daten").Visible = False
Sheets("Eingabe").Select
Range("A1").Select
End Sub


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

Betreff
Datum
Anwender
Anzeige
versuche es mal so
24.02.2009 07:25:55
Tino
wenn ein Makro mit der Zeile On Error Resume Next beginnt,
ist eigentlich schon alles gesagt, mach dies mal raus und schon kommst Du beim Durchlauf die Fehlerhaften Zeilen angemeckert die Du so aber umgehst.
Hier eine alternative zu Deiner Version.
.ScreenUpdating und .EnableEvents kann man eigentlich weglassen,
Makro ist schnell genug, aber ich kenne Deine Datei nicht und daher habe ich es mal mit eingebaut.
Sub Listen()
Dim Datum1 As Date
Dim iRow As Long, iColumns As Long
Dim TimeU As Double

If Not IsDate(Sheets("Eingabe").Cells(1, 1)) Then
 MsgBox "Es ist kein Datum in der Zelle", vbCritical
 Exit Sub
End If

Datum1 = Sheets("Eingabe").Cells(1, 1)
TimeU = TimeSerial(8, 0, 0)


With Application
 .ScreenUpdating = False
 .EnableEvents = False
   
        With Sheets("Daten")
                iRow = .Cells(.Rows.Count, 1).End(xlUp).Row
                iColumns = 1
            Do
                iRow = iRow + 1
                .Cells(iRow, iColumns).Value = Datum1
                .Cells(iRow, iColumns + 1).Value = TimeU
                TimeU = TimeU + TimeSerial(0, 15, 0)
            Loop While TimeU <= TimeSerial(18, 0, 0)
        End With 'Sheets("Daten") 
    
  Sheets("Eingabe").Select
  Range("A1").Select
 
 .ScreenUpdating = True
 .EnableEvents = True
End With 'Application 
End Sub


Gruß Tino

Anzeige
AW: Makro Dauer zu lange
24.02.2009 11:05:42
Daniel
Hi
warum es jetzt so lange dauert, kann man, ohne deine Daten zu kennen nicht sagen.
die Schleife ist zwar überflüssig, aber mit 41 Durchläufen noch recht kurz und dürfte nicht diese Zeit erfordern.
gibt es u.U. noch aufendige Berechnungen, die sich auf den Zellbereich beziehen und jedes mal angestossen werden, wenn ein Wert eingegragen wird, oder gibt es ein WORKSHEET_CHANGE-Makro für das Tabellenblatt "Daten" ?
Was auf jeden Fall auffällig ist:
1. wie von Tino schon erwähnt: "On Errror Resume Next" wird NIE NIEMALS NICHT einfach nur so pauschal über den Code drübergeschrieben. Sonst darf man sich nicht wundern, wenn der Code seltsame Ergebnisse liefert.
2. "Datum1 = Format(CDbl("dd.mm.yyyy"))" macht keinen Sinn. Was willst du damit bewirken?
3. Variablenzuweisungen, die sich nicht ändern, setzt man immer außerhalb der Schleife, nie innerhalb.
Innerhalb der Schleife werden nur Variablen zugewiesen, die sich mit der Schleifenvariable ändern
hier mal eine Makroversion ohne Schleifen, das sollte schneller sein:

Sub Listen()
Dim Datum1 As Variant
Dim iRow As Integer
Dim iColumns As Integer
Dim Endrow As Integer
Dim TimeU As Double
Datum1 = Sheets("Eingabe").Cells(1, 1).Value
'Datum1 = Format(CDbl(Datum1,"dd.mm.yyyy"))
TimeU = 0.33333
Endrow = Sheets("Daten").Cells(Rows.Count, 1).End(xlUp).Row
iColumns = 1
With Sheets("Daten")
.Cells(Endrow + 1, iColumns).Resize(41).Value = Datum1
.Cells(Endrow + 1, iColumns + 1).Value = TimeU
With .Cells(Endrow + 2, iColumns + 1).Resize(40)
.FormulaR1C1 = "=R[-1]C+(1/24/4)"
.Formula = .Value
End With
End With
Sheets("Eingabe").Select
Range("A1").Select
End Sub


Gruß, Daniel

Anzeige
AW: noch ne Version
24.02.2009 11:25:36
Erich
Hallo Ludmila,
hier auch noch meine Version - Daniels irgendwie ähnlich... :-)

Sub Listen2()
Dim lngR As Long
If Not IsDate(Sheets("Eingabe").Cells(1, 1)) Then
MsgBox "Es ist kein Datum in der Zelle", vbCritical
Exit Sub
End If
With Sheets("Daten")
lngR = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(lngR, 1).Resize(41).Value = Sheets("Eingabe").Cells(1, 1).Value
With .Cells(lngR, 2).Resize(41)
.Formula = "=TIME(8, 15*(ROW()-" & lngR & "), 0)"
.Formula = .Value
End With
End With
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Anzeige
AW: noch ne Version
24.02.2009 16:00:48
Ludmila
Danke, Daniel und Erich beide Makros funktionieren so wie ich es wollte!
Gruß
Ludmila

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige