Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema TextBox
BildScreenshot zu TextBox TextBox-Seite mit Beispielarbeitsmappe aufrufen

Makro zu langsam

Betrifft: Makro zu langsam von: Frank H.
Geschrieben am: 18.11.2014 17:01:33

Hallo Zusammen!

Auf einer UF befinden sich 3 TextBoxen, in TextBox1 steht das Datum zu Beginn, in TextBox2 steht das Datum für das Ende, also Einträge werden von bis vorgenommen, aber da die Wochenenden ausgespart wereden sollen wird das Makro sehr langsam.
Hier das Makro:

With frmUrlaubserfassung

If ComboBox1.ListIndex = 1 Then

For lng = 6 To 6579

If Cells(lng, 1).Value > CDate(.TextBox2) Then Exit For

If Cells(lng, 1).Value >= CDate(.TextBox1) Then

Sheets("Urlaubsdaten").Cells(lng, 10) = .TextBox3

End If

If Weekday(Cells(lng, 1)) = 1 Or Weekday(Cells(lng, 1)) = 7 Then
Sheets("Urlaubsdaten").Cells(lng, 10) = ""
End If


Next lng

End If

End With

Kann damit jemand was anfangen und helfen, bitte!

Danke und Gruß Frank H.

  

Betrifft: AW: Makro zu langsam von: Tino
Geschrieben am: 18.11.2014 17:30:50

Hallo,
weis nicht ob ich alles richtig verstanden habe, kannst mal testen.
Für was ist die Textbox3?

Dim n&, nn&
Dim DateAnf&, DateEnde&
Dim ArDate()

'Datum von und bis in Variable
With frmUrlaubserfassung
    DateAnf = CDate(.TextBox1)
    DateEnde = CDate(.TextBox2)
End With
    
'Ist Wochenden?
Do While Weekday(DateAnf, vbMonday) > 5
    DateAnf = DateAnf + 1
Loop

'Ist Wochenden?
Do While Weekday(DateEnde, vbMonday) > 5
    DateEnde = DateEnde - 1
Loop

'Array für Daten groß genug erstellen
ReDim Preserve ArDate(1 To DateEnde - DateAnf + 1)

For n = DateAnf To DateEnde
    If Weekday(n, vbMonday) < 6 Then
        nn = nn + 1
        ArDate(nn) = n
    End If
Next n

'Array anpassen as Daten
ReDim Preserve ArDate(1 To nn)

'Ausgabe
With Sheets("Urlaubsdaten")
    'alte Daten löschen
    .Range("A6", .Cells(.Rows.Count, 1)).Clear
    'Datenbereich
    With .Cells(6, 1).Resize(nn)
        'Format
        .NumberFormat = "ddd, dd/mm/yyyy"
        'Daten einfügen
        .Value = Application.Transpose(ArDate)
    End With
End With
Gruß Tino


  

Betrifft: Upload ... von: Matthias L
Geschrieben am: 18.11.2014 17:31:56

Hallo Frank

Kannst Du ein Bsp hochladen?
Hab keine Lust zum Nachbauen.

Evtl. reicht aber auch schon zu Beginn ein:

Application.ScreenUpdating =False
Gruß Matthias


  

Betrifft: AW: Upload ... von: Frank H.
Geschrieben am: 18.11.2014 18:00:34

Hallo Ihr Zwei!

Der Code beginnt mit Application.ScreenUpdating =False, das habe ich vorhin weggelassen.

Mit dem Vorschlag von Tino bin ich wohl ein wenig überfordert. Meine Datei ist für ein Upload zu groß.

In Spalte 1 stehen untereinander Datumswerte, von 01.01.2014 - 31.12.2031. Die Daten aus TextBox3 werden immer in Spalte 10, hinter das Datum von bis (TextBox1 - TextBox2) eingetragen, aber eben nicht an Wochenenden. Vielleicht kann jetzt einer helfen. Danke!

Gruß Frank H.


  

Betrifft: müsste doch funktionieren (bei mir 0,04 Sek.)... von: Tino
Geschrieben am: 18.11.2014 18:46:23

Hallo,
denke habe alles beachtet.

Dim n&, nn&
Dim DateAnf&, DateEnde&
Dim ArDate()
Dim sText$

'Datum von und bis in Variable
With frmUrlaubserfassung
    DateAnf = CDate(.TextBox1)
    DateEnde = CDate(.TextBox2)
    sText = .TextBox3
End With
    
'Ist Wochenden?
Do While Weekday(DateAnf, vbMonday) > 5
    DateAnf = DateAnf + 1
Loop

'Ist Wochenden?
Do While Weekday(DateEnde, vbMonday) > 5
    DateEnde = DateEnde - 1
Loop

'Array für Daten groß genug erstellen
ReDim Preserve ArDate(1 To DateEnde - DateAnf + 1)

For n = DateAnf To DateEnde
    If Weekday(n, vbMonday) < 6 Then
        nn = nn + 1
        ArDate(nn) = n
    End If
Next n

'Array anpassen as Daten
ReDim Preserve ArDate(1 To nn)

'Ausgabe
With Sheets("Urlaubsdaten")
    'alte Daten löschen
    .Range("A6", .Cells(.Rows.Count, 1)).Clear
    'Datenbereich
    With .Cells(6, 1).Resize(nn, 10)
        'Format evtl. anpassen
        .Columns(1).NumberFormat = "ddd, dd/mm/yyyy"
        'Daten einfügen
        .Columns(1).Value = Application.Transpose(ArDate)
        
        'Spalte 10 Daten aus Texbox 3
        .Columns(10).Value = sText
    End With
End With
Gruß Tino


  

Betrifft: Manno, jetzt hab ich doch nachgebaut ... von: Matthias L
Geschrieben am: 18.11.2014 19:00:28

Hallo

Hier mal mit Deinen Codezeilen

https://www.herber.de/bbs/user/93854.xlsm

Gruß Matthias


  

Betrifft: AW: Manno, jetzt hab ich doch nachgebaut ... von: Frank H.
Geschrieben am: 18.11.2014 19:06:21

Hallo Ihr Zwei!

Funzt beides! Ihr seid Spitze, allerherzlichsten Dank!

Gruß Frank H.


 

Beiträge aus den Excel-Beispielen zum Thema "Makro zu langsam"