Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1624to1628
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

Rechenzeitoptzimierung

Rechenzeitoptzimierung
03.06.2018 21:28:12
Philipp
Hallo Leute,
ich möchte das unten aufgeführte Programm in seiner Berechnungszeit optimieren.
Die Zeile "Application.ScreenUpdating = False" MUSS entfallen und ist deshalb ausgeblendet.
Meiner Meinung nach wäre ein Befehl der alle Zeilen für die "If Cells(Zeile, Spalte) 0 Then"
erfüllt, nacheinander in die Zwischenablage kopiert und am Ende alles in die zweite Tabelle einfügt, am besten.
Leider sind hier meine VBA-Kenntnisse, besonders im Bezug auf den Syntax am Ende.

Sub Druck()
'Application.ScreenUpdating = False
Dim Spalte As Integer
Dim Zeile As Integer
Dim Zeilendifferenz As Integer
Spalte = 4 'Spalte für Bedingung
Zeile = 5 'Beginn zeile Bedingung
Zeilendifferenz = 5 'Zeile in Tabelle Druck (Einfügen Übertrag)
Application.CutCopyMode = False
With Worksheets("Eingabe")
While Zeile  0 Then
Rows(Zeile).Select
Selection.Copy
Sheets("Kalkulation").Select
Rows(Zeilendifferenz).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range(Cells(1, 1), Cells(Spalte, Zeilendifferenz)).Select
Zeilendifferenz = Zeilendifferenz + 1
Worksheets("Eingabe").Select
End If
Zeile = Zeile + 1
Wend
Sheets("Kalkulation").Select
Range("A1").Select
End With
End Sub

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Rechenzeitoptzimierung
03.06.2018 21:44:32
Sepp
Hallo Philipp,
ungetestet!
Sub Druck()
  Dim Spalte As Long, Zeile As Long, Zeilendifferenz As Long, lngRow As Long
  Dim rngCopy As Range
  
  Spalte = 4 'Spalte für Bedingung 
  Zeile = 5 'Beginn zeile Bedingung 
  Zeilendifferenz = 5 'Zeile in Tabelle Druck (Einfügen Übertrag) 

  With Worksheets("Eingabe")
    For lngRow = Zeile To 150
      If .Cells(Zeile, Spalte) <> 0 Then
        If rngCopy Is Nothing Then
          Set rngCopy = .Rows(Zeile)
        Else
          Set rngCopy = Union(rngCopy, .Rows(Zeile))
        End If
      End If
    Next
  End With

  If Not rngCopy Is Nothing Then
    rngCopy.Copy
    With Sheets("Kalkulation").Cells(1, Zeilendifferenz)
      .PasteSpecial Paste:=xlValues
      .PasteSpecial Paste:=xlFormats
    End With
    Application.CutCopyMode = False
  End If
  
  Set rngCopy = Nothing
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media

Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0


 ABCDEF
1Gruß Sepp
2
3

Anzeige
AW: Rechenzeitoptzimierung
03.06.2018 21:54:37
Günther
Moin,
aus meiner Sicht ist die Anmerkung (und Durchsetzung) von "Die Zeile "Application.ScreenUpdating = False" MUSS entfallen" genauso überflüssig wie die ganzen Bremsen namens "Select". Aus meiner Sicht gibt es keinen einzigen sinnnvollen Grund, ScreenUpdating eingeschaltet zu lassen und die gnzen elenden "Select"-Anweisungen einzusetzen.
Mein Tipp: Beschäftige dich ein bis 3 Stunden mit des absoluten Basics des VBA, dann wirst du zwar weiterhin Fragen haben aber nicht deratige Behauptungen in den Raum stellen, die einen erfahrenen Programmierer einfach nur ärgern und zu Reaktionen wie meiner bewegen.
Anzeige
Letzt getestet!
03.06.2018 21:55:28
Sepp
Hallo Philipp,
Sub Druck()
  Dim Spalte As Long, Zeile As Long, Zeilendifferenz As Long, lngRow As Long
  Dim rngCopy As Range
  
  Spalte = 4 'Spalte für Bedingung 
  Zeile = 5 'Beginn zeile Bedingung 
  Zeilendifferenz = 5 'Zeile in Tabelle Druck (Einfügen Übertrag) 

  With Worksheets("Eingabe")
    For lngRow = Zeile To 150
      If .Cells(lngRow, Spalte) <> 0 Then
        If rngCopy Is Nothing Then
          Set rngCopy = .Rows(lngRow)
        Else
          Set rngCopy = Union(rngCopy, .Rows(lngRow))
        End If
      End If
    Next
  End With

  If Not rngCopy Is Nothing Then
    rngCopy.Copy
    With Sheets("Kalkulation").Cells(Zeilendifferenz, 1)
      .PasteSpecial Paste:=xlValues
      .PasteSpecial Paste:=xlFormats
    End With
    Application.CutCopyMode = False
  End If
  
  Set rngCopy = Nothing
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media

Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0


 ABCDEF
1Gruß Sepp
2
3

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige