Microsoft Excel

Herbers Excel/VBA-Archiv

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

Performance steigern

Betrifft: Performance steigern von: Stefanie
Geschrieben am: 28.08.2014 11:26:15

Hallo an alle :-)

vielleicht kennt ihr das: Endlich ist der Code fertig und tut auch das was er soll, leider ist die Performance richtig mies.

So ist es zumindest bei mir. Gibt es eine Möglichkeit, zum Beispiel beim durchsuchen einzelner Zellen dies nicht im Tabellenblatt zu tun, sondern im internen Speicher?

Also die Zeile auf eine Variable legen und dann intern durchsuchen ?

Vielen Dank für euere Performance Tricks und Tipp :-)

VG

  

Betrifft: AW: Performance steigern von: Beverly
Geschrieben am: 28.08.2014 11:37:27

Hi Stefanie,

möglich ist vieles - man könnte z.B. einen Zellbereich in ein Array einlesen und dort dann suchen.


GrußformelBeverly's Excel - Inn


  

Betrifft: AW: Performance steigern von: Stefanie
Geschrieben am: 28.08.2014 13:36:44

Genau sowas suche ich :-) Hättest du dafür vielleicht ein kurzes Beispiel ?
Wäre super
VG


  

Betrifft: AW: Performance steigern von: Daniel
Geschrieben am: 28.08.2014 13:46:13

Hi

mal spontan ein kleines Beispiel:

Langsam ist direkte Zellbearbeitung:

dim i als long
With Range("A1:A10000")
   .Value = 1
   for i = 1 to .Cells.Count
     .Cells(i, 1).Value = .Cells(i, 1).Value * i + .Cells(i, 1).value
   next
End with
Schneller ist, die Werte ins Array zu laden und dann zu bearbeiten:
Dim arr
dim i as long
With Range("A1:A10000")
   .Value = 1
   arr = .Value
   for i = 1 to Ubound(arr, 1)
      arr(i, 1) = arr(i, 1) * 1 + arr(i, 1)
   next
   .Value = arr
End With
Gruß Daniel


  

Betrifft: AW: Performance steigern von: Stefanie
Geschrieben am: 28.08.2014 13:51:10

ah okay... Danke! sowas brauche ich bestimmt :) und was macht dieses Ubound ?


  

Betrifft: AW: Performance steigern von: Daniel
Geschrieben am: 28.08.2014 14:01:17

Hi

das Ubound ermittelt die höchste Indexnummer des Arrays in der ersten Dimension (also die Anzahl der Zeilen)

die kleinste Zeilennummer liesse sich mit LBound ermitteln.
Das ist hier aber unnötig, denn die ist - wenn du einen Zellbereich in ein Array kopierst - immer 1.

Gruß Daniel


  

Betrifft: AW: Performance steigern von: Daniel
Geschrieben am: 28.08.2014 14:01:23

Hi

das Ubound ermittelt die höchste Indexnummer des Arrays in der ersten Dimension (also die Anzahl der Zeilen)

die kleinste Zeilennummer liesse sich mit LBound ermitteln.
Das ist hier aber unnötig, denn die ist - wenn du einen Zellbereich in ein Array kopierst - immer 1.

Gruß Daniel


  

Betrifft: AW: Performance steigern von: Daniel
Geschrieben am: 28.08.2014 14:01:51

Hi

das Ubound ermittelt die höchste Indexnummer des Arrays in der ersten Dimension (also die Anzahl der Zeilen)

die kleinste Zeilennummer liesse sich mit LBound ermitteln.
Das ist hier aber unnötig, denn die ist - wenn du einen Zellbereich in ein Array kopierst - immer 1.

Gruß Daniel


  

Betrifft: AW: Performance steigern von: Stefanie
Geschrieben am: 28.08.2014 14:15:13

super danke für deine Hilfe werde ich mal ausprobieren :)


  

Betrifft: AW: Performance steigern von: fcs
Geschrieben am: 28.08.2014 12:03:49

Hallo Stefanie,

Arrays bringen erst ab ca. 1000 Zellen signifikante Geschwindigkeitsvorteile oder wenn für den gleichen Zellbereich die Such-/Vergleichsaktionen innerhalb des Makros sehr häufig ausgeführt werden sollen.

Andere Sachen wie:
- automatische Berechnung
- Ereignismakros im Tabellenblatt
- Bildschirmaktualisierung
- Select- und Activate-Aktionen im Makro
können Makros auch extrem ausbremsen.

Desahalb ist es oft ratsam bestimmte Einstellungen zu Beginn eines Makros zu machen, die die Bremsen lösen und am Ende eines Makros die Einstellungen wieder zurückzusetzen.

Nachfolgend ein kleines Beispiel inkl. Einlesen von Zellinhalten in ein Array.

Gruß
Franz

Sub aaTest()
  Dim StatusCalc As Long
  Dim arrZellen As Variant
  Dim wks As Worksheet
  Dim Zeile As Long, varSuchwert
  
  Set wks = ActiveSheet 'Tabellenblatt mit den Daten für das Array
    'Makrobremsen lösen
    With Application
      .EnableEvents = False
      .ScreenUpdating = False
      StatusCalc = .Calculation
      .Calculation = xlCalculationManual
    End With
    
    With wks
      'Zellen-Inhalte in Spalte A in Array laden
      arrZellen = .Range(.Cells(1, 1), .Cells(.UsedRange.Row + .UsedRange.Rows.Count - 1, 1))
      varSuchwert = 3
      For Zeile = 2 To UBound(arrZellen, 1)
        If varSuchwert = arrZellen(Zeile, 1) Then
          MsgBox "gesuchter Wert in Zeile " & Zeile
        End If
      Next
    End With
    
    'Makrobremsen zurücksetzen
    With Application
      .EnableEvents = True
      .ScreenUpdating = True
      .Calculation = StatusCalc
    End With
End Sub



  

Betrifft: AW: Performance steigern von: ransi
Geschrieben am: 28.08.2014 12:20:44

Hallo Stefanie

Kaum ein Code ist so gut als das er nicht zu optimieren ist ;-)
Allerdings sind die Möglichkeiten da sehr groß.
Zeigst du uns mal deinen Code ?

ransi


  

Betrifft: AW: Performance steigern von: Stefanie
Geschrieben am: 28.08.2014 13:48:53

Oh der ist ziemlich lang :)
Also solche If Anweisungen habe ich mehrere, da denke ich wäre es sinnvoll eine Funktion zu schreiben und die Variablen zu übergeben.
Aber auch die Schleifen sind sehr langsam.
Danke euch VG

Hier ein Ausschnitt:

 If Inhalt = "XY" Then
 index_P = 1
   Columns.Find(What:=Inhalt, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
    :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
    False).EntireColumn.Select
    Selection.Copy
     Sheets("Arbeitsblatt1").Activate
    Sheets("Arbeitsblatt1").Select
    '--------------------------------------------------------------------------
    'letzte Freie Spalte ermitteln
    Cells(1, IIf(IsEmpty(Cells(1, Columns.Count)), _
    Cells(1, Columns.Count).End(xlToLeft).Column, Columns.Count) + 1).Select
    aktuelle_spalte = ActiveCell.EntireColumn.Column
    '---------------------------------------------------------------------------
    ActiveSheet.Paste
    Application.CutCopyMode = False
    'Jetzt muss Asset noch umbenannt werden
    Sheets("Arbeitsblatt2").Select
    Cells(Q_Zeile, 4).Select
    Selection.Copy
    Sheets("Arbeitsblatt1").Select
    Cells(1, aktuelle_spalte).Select
    ActiveSheet.Paste
    'Zellen einfärben
    Cells(1, aktuelle_spalte).Interior.Color = RGB(255, 235, 156)
    'Nun müssen diese noch in Risikobeurteilung eingetragen werden
    Cells(1, aktuelle_spalte).Select
    Bezeichnung = Cells(1, aktuelle_spalte).Value
    'MsgBox Bezeichnung
    Sheets("Arbeitsblatt1").Select

    'Bereich = "H4:H49"
      For Each Zelle In Range(Cells(4, aktuelle_spalte), Cells(49, aktuelle_spalte))
      'Bereich muss auch noch variabel werden
      'Range(cells(1,variable),cells(49,variable))
             If Zelle.Value = "x" Then
               Q_Zelle = "A" & Zeile_P
               Range(Q_Zelle).Activate
               Inhalt = ActiveCell.Value
               Selection.Copy
               Sheets("Arbeitsblatt3").Activate
               Sheets("Arbeitsblatt3").Select
              'Freie Zelle in Spalte B suchen und dort eintragen
               b = Cells(Rows.Count, 2).End(xlUp).Row + 1
               Cells(b, 2).Select
               ActiveSheet.Paste
               a = Cells(Rows.Count, 1).End(xlUp).Row + 1
               Cells(a, 1) = Bezeichnung
            
                        Sheets("Arbeitsblatt4").Select
                        If Cells(Zeile_P, 137).Value = "x" Then
                        Zeile_A = Zeile_P
                        'Merke dir die Zelle
                        Q_Zelle = "A" & Zeile_A
                        Range(Q_Zelle).Activate
                        Inhalt2 = ActiveCell.Value
                        'Gehe eine Zeile weiter
                        ActiveCell.Offset(0, 1).Select
              
         
                    For i = 2 To 20
                      For Each Zelle_X In Range(Cells(Zeile_A, i), Cells(Zeile_A, i))
                        
                         Range(Cells(Zeile_A, i), Cells(Zeile_A, i)).Select
                             If Range(Cells(Zeile_A, i), Cells(Zeile_A, i)).Value = "x" Then
                                  ActiveCell.EntireColumn.Select
                                  x = ActiveCell.EntireColumn.Column
                                  'MsgBox x
                                  Cells(3, x).Select
                                  Cells(3, x).Copy
                                  Sheets("Arbeitsblatt3").Select                                 _

                                  Cells(b, y).Select
                                  ActiveSheet.Paste                                
                                  Cells(b, y).WrapText = True
                                  ActiveSheet.Range("A4:ED" & x).Rows.EntireRow.AutoFit
                                  Sheets("Arbeitsblatt4").Select
                                 
                                  Cells(1, x).Select
                                  Cells(1, x).Copy
                                  Sheets("Arbeitsblatt3").Select
                                  
                                  'Cells(4, IIf(IsEmpty(Cells(1, Columns.Count)), _
                                  'Cells(4, Columns.Count).End(xlToLeft).Column, Columns.Count)  _
+ 1).Select
                                  'aktuelle_spalte_annex = ActiveCell.EntireColumn.Column
                                  'Cells(b, aktuelle_spalte_annex).FormulaR1C1 = "Annex"
                                  Cells(b, aa).Select
                                  ActiveSheet.Paste
                                 y = aa + 1
                                 aa = y + 1
                                 Sheets("Arbeitsblatt4").Select
                               
                              End If
                        Next Zelle_X
                               
                     Next i
                     y = 15
                    aa = 16
                   End If
          
               
         
          End If
        Zeile_P = Zeile_P + 1
     Sheets("Gefährdungen").Select
   Next Zelle
 End If
End If



  

Betrifft: AW: Performance steigern : ohne Select ! von: Daniel
Geschrieben am: 28.08.2014 13:55:30

Hi
hier solltest du erstmal das hier lesen, verstehen und anwenden.
http://www.online-excel.de/excel/singsel_vba.php?f=78
http://www.online-excel.de/excel/singsel_vba.php?f=61
es sollte eine signifikante Steigerung der Performance bringen.
desweiteren wird dein Code kürzer und übersichlicher, was in vielen Fällen dazu führt, dass dir unnötige Programmschritte oder weitere Optimierungsmöglichkeiten schneller auffallen.

Gruß Daniel


  

Betrifft: AW: Performance steigern : ohne Select ! von: Stefanie
Geschrieben am: 28.08.2014 14:16:15

ok danke dann schaue ich mir das mal an!


  

Betrifft: AW: Performance steigern : ohne Select ! von: Stefanie
Geschrieben am: 28.08.2014 14:20:19

Das ist echt super danke. Select verwende ich ja auch ziemlich oft ;)