Makro ist unerträglich langsam

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
InputBox MsgBox
Bild

Betrifft: Makro ist unerträglich langsam
von: Hendrik
Geschrieben am: 06.11.2003 14:31:07

Habe ein Makro programmiert, es funktioniert auch grundsätzlich aber es ist extrem langsam. Kann mir jemand sagen warum das so unglaublich lange braucht?
Was kann an dem Makro vereinfacht werden. Ich komme da einfach nicht weiter.

Vielen Dank
Gruß
Hendrik


Private Sub Start_report_Click()
Dim r, o, p, u, v
Dim eing
Dim s As Integer
Dim zelle As Range
Dim rng As Range
  
  Application.ScreenUpdating = False
  
  Rows("7:500").Select   'hiermit werden ganze zeilen selektiert
  Selection.EntireRow.Hidden = True  'die selektion ausblenden
  
  Columns("I:CW").Select 'Spalten selektieren
  Selection.EntireColumn.Hidden = True 'Selektion ausblenden
  eing = InputBox("Bitte die Spalte angeben, für die ein Report erzeugt werden soll. Zum Beispiel , , , usw.", "Zellenauswahl")
  If eing = "i" Or eing = "I" Then
    Columns("I").Select
    p = 9
  End If
  If eing = "j" Or eing = "I" Then
    Columns("J").Select
    p = 10
  End If
  If eing = "k" Or eing = "K" Then
    Columns("K").Select
    p = 11
  End If
  If eing = "l" Or eing = "L" Then
    Columns("L").Select
    p = 12
  End If
  If eing = "m" Or eing = "M" Then
    Columns("M").Select
    p = 13
  End If
  If eing = "n" Or eing = "N" Then
    Columns("N").Select
    p = 14
  End If
  If eing = "o" Or eing = "O" Then
    Columns("O").Select
    p = 15
  End If
  If eing = "p" Or eing = "P" Then
    Columns("P").Select
    p = 16
  End If
  If eing = "q" Or eing = "Q" Then
    Columns("Q").Select
    p = 17
  End If
  If eing = "r" Or eing = "R" Then
    Columns("R").Select
    p = 18
  End If
  If eing = "s" Or eing = "S" Then
    Columns("S").Select
    p = 19
  End If
  If eing = "t" Or eing = "T" Then
    Columns("T").Select
    p = 20
  End If
  If eing = "u" Or eing = "U" Then
    Columns("U").Select
    p = 21
  End If
  If eing = "v" Or eing = "V" Then
    Columns("V").Select
    p = 22
  End If
  If eing = "w" Or eing = "W" Then
    Columns("W").Select
    p = 23
  End If
  If eing = "x" Or eing = "X" Then
    Columns("X").Select
    p = 24
  End If
  If eing = "y" Or eing = "Y" Then
    Columns("Y").Select
    p = 25
  End If
  If eing = "z" Or eing = "Z" Then
    Columns("Z").Select
    p = 26
  End If
  If eing = "aa" Or eing = "AA" Then
    Columns("AA").Select
    p = 27
  End If
  If eing = "ab" Or eing = "AB" Then
    Columns("AB").Select
    p = 28
  End If
  If eing = "ac" Or eing = "AC" Then
    Columns("AC").Select
    p = 29
  End If
  If eing = "ad" Or eing = "AD" Then
    Columns("AD").Select
    p = 30
  End If
  If eing = "ae" Or eing = "AE" Then
    Columns("AE").Select
    p = 31
  End If
  If eing = "af" Or eing = "AF" Then
    Columns("AF").Select
    p = 32
  End If
  If eing = "ag" Or eing = "AG" Then
    Columns("AG").Select
    p = 33
  End If
  If eing = "ah" Or eing = "AH" Then
    Columns("AH").Select
    p = 34
  End If
  If eing = "ai" Or eing = "AI" Then
    Columns("AI").Select
    p = 35
  End If
  If eing = "aj" Or eing = "AJ" Then
    Columns("AJ").Select
    p = 36
  End If
  If eing = "ak" Or eing = "AK" Then
    Columns("AK").Select
    p = 37
  End If
  If eing = "al" Or eing = "AL" Then
    Columns("AL").Select
    p = 38
  End If
  If eing = "am" Or eing = "AM" Then
    Columns("AM").Select
    p = 39
  End If
  If eing = "an" Or eing = "AN" Then
    Columns("AN").Select
    p = 40
  End If
  If eing = "ao" Or eing = "AO" Then
    Columns("AO").Select
    p = 41
  End If
  If eing = "ap" Or eing = "AP" Then
    Columns("AP").Select
    p = 42
  End If
  If eing = "aq" Or eing = "AQ" Then
    Columns("AQ").Select
    p = 43
  End If
  If eing = "ar" Or eing = "AR" Then
    Columns("AR").Select
    p = 44
  End If
  If eing = "as" Or eing = "AS" Then
    Columns("AS").Select
    p = 45
  End If
  If eing = "at" Or eing = "AT" Then
    Columns("AT").Select
    p = 46
  End If
  If eing = "au" Or eing = "AU" Then
    Columns("AU").Select
    p = 47
  End If
  If eing = "av" Or eing = "AV" Then
    Columns("AV").Select
    p = 48
  End If
  If eing = "aw" Or eing = "AW" Then
    Columns("AW").Select
    p = 49
  End If
  If eing = "ax" Or eing = "AX" Then
    Columns("AX").Select
    p = 50
  End If
  If eing = "ay" Or eing = "AY" Then
    Columns("AY").Select
    p = 51
  End If
  If eing = "az" Or eing = "AZ" Then
    Columns("AZ").Select
    p = 52
  End If
  If eing = "ba" Or eing = "BA" Then
    Columns("BA").Select
    p = 53
  End If
  If eing = "bb" Or eing = "BB" Then
    Columns("BB").Select
    p = 54
  End If
  If eing = "bc" Or eing = "BC" Then
    Columns("BC").Select
    p = 55
  End If
  If eing = "bd" Or eing = "BD" Then
    Columns("BD").Select
    p = 56
  End If
  If eing = "be" Or eing = "BE" Then
    Columns("BE").Select
    p = 57
  End If
  If eing = "bf" Or eing = "BF" Then
    Columns("BF").Select
    p = 58
  End If
  If eing = "bg" Or eing = "BG" Then
    Columns("BG").Select
    p = 59
  End If
  If eing = "bh" Or eing = "BH" Then
    Columns("BH").Select
    p = 60
  End If
  If eing = "bi" Or eing = "BI" Then
    Columns("BI").Select
    p = 61
  End If
  If eing = "bj" Or eing = "BJ" Then
    Columns("BJ").Select
    p = 62
  End If
  If eing = "bk" Or eing = "BK" Then
    Columns("BK").Select
    p = 63
  End If
  If eing = "bl" Or eing = "BL" Then
    Columns("BL").Select
    p = 64
  End If
  If eing = "bm" Or eing = "BM" Then
    Columns("BM").Select
    p = 65
  End If
  If eing = "bn" Or eing = "BN" Then
    Columns("BN").Select
    p = 66
  End If
  If eing = "bo" Or eing = "BO" Then
    Columns("BO").Select
    p = 67
  End If
  If eing = "bp" Or eing = "BP" Then
    Columns("BP").Select
    p = 68
  End If
  If eing = "bq" Or eing = "BQ" Then
    Columns("BQ").Select
    p = 69
  End If
  If eing = "br" Or eing = "BR" Then
    Columns("BR").Select
    p = 70
  End If
  If eing = "bs" Or eing = "BS" Then
    Columns("BS").Select
    p = 71
  End If
  If eing = "bt" Or eing = "BT" Then
    Columns("BT").Select
    p = 72
  End If
  If eing = "bu" Or eing = "BU" Then
    Columns("BU").Select
    p = 73
  End If
  If eing = "bv" Or eing = "BV" Then
    Columns("BV").Select
    p = 74
  End If
  If eing = "bw" Or eing = "BW" Then
    Columns("BW").Select
    p = 75
  End If
  If eing = "bx" Or eing = "BX" Then
    Columns("BX").Select
    p = 76
  End If
  If eing = "by" Or eing = "BY" Then
    Columns("BY").Select
    p = 77
  End If
  If eing = "bz" Or eing = "BZ" Then
    Columns("BZ").Select
    p = 78
  End If
  If eing = "ca" Or eing = "CA" Then
    Columns("CA").Select
    p = 79
  End If
  If eing = "cb" Or eing = "CB" Then
    Columns("CB").Select
    p = 80
  End If
  If eing = "cc" Or eing = "CC" Then
    Columns("CC").Select
    p = 81
  End If
  If eing = "cd" Or eing = "CD" Then
    Columns("CD").Select
    p = 82
  End If
  If eing = "ce" Or eing = "CE" Then
    Columns("CE").Select
    p = 83
  End If
  If eing = "cf" Or eing = "CF" Then
    Columns("CF").Select
    p = 84
  End If
  If eing = "cg" Or eing = "CG" Then
    Columns("CG").Select
    p = 85
  End If
    If eing = "ch" Or eing = "CH" Then
    Columns("CH").Select
    p = 86
  End If
  Selection.EntireColumn.Hidden = False
  For r = 7 To 500
    Cells(r, p).Select
    For Each zelle In Selection
      If Not IsNumeric(zelle.Value) And Not IsEmpty(zelle.Value) Then
        Rows(r).Select
        Selection.EntireRow.Hidden = False
      End If
    Next zelle
  Next r
    
  Application.ScreenUpdating = False
  Range("A1").Select
  Set rng = Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
  sFile = Cells(1, p)
  rFile = Cells(4, p)
  Workbooks.Add
  Range.Copy Range("A1")
  'ActiveWorkbook.SaveAs "Reporting " & sFile & "." & rFile & ".xls"
  'ActiveWorkbook.Close savechanges:=True
  Application.ScreenUpdating = True
  Range("A1").Select
  MsgBox "Reporting gespeichert!"
End Sub

Bild


Betrifft: AW: Makro ist unerträglich langsam
von: Michael Scheffler
Geschrieben am: 06.11.2003 14:43:09

Hallo,

leider hast Du unerträglich viele "If"s und "Select"-Befehle hineinprogrammiert. Das kann doch bei VBA gut nicht passieren.

Gruß

Micha


Bild


Betrifft: AW: Makro ist unerträglich langsam
von: Jens
Geschrieben am: 06.11.2003 15:04:31

Hallo

Vielleicht mal Ohne Select und ohne ein Dutzend unnötiger If abfragen.


Private Sub Start_report_Click()
Dim eing
Dim zelle As Range
Dim rng As Range
Dim Col As Byte
  
  Application.ScreenUpdating = False
  
  Rows("7:500").EntireRow.Hidden = True 'ausblenden
  Columns("I:CW").EntireColumn.Hidden = True 'ausblenden
  
  eing = InputBox("Bitte die Spalte angeben, für die ein Report erzeugt werden soll. Zum Beispiel , , , usw.", "Zellenauswahl")
  
Col = Columns(eing).Column
  
If Col < 9 And Col > 86 Then Exit Sub 'Eingabe zwischen I und CH, Groß Klein ist egal
 
    Columns(Col).EntireColumn.Hidden = False
  For Each zelle In Range(Cells(7, Col), Cells(500, Col))
      If Not IsNumeric(zelle.Value) And Not IsEmpty(zelle.Value) Then
        Rows(r).EntireRow.Hidden = False
      End If
  Next zelle
    
  Application.ScreenUpdating = False
  Set rng = Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
  sFile = Cells(1, Col)
  rFile = Cells(4, Col)
  Workbooks.Add
  rng.Copy Range("A1")
  'ActiveWorkbook.SaveAs "Reporting " & sFile & "." & rFile & ".xls"
  'ActiveWorkbook.Close savechanges:=True
  Application.ScreenUpdating = True
  MsgBox "Reporting gespeichert!"
End Sub


Gruß Jens, vielleicht hilft es ein wenig weiter.


Bild


Betrifft: AW: Makro ist unerträglich langsam
von: xXx
Geschrieben am: 06.11.2003 15:07:34

Hallo,
nimm mal das als Denkansatz:

Sub test2()
  Columns("I:CW").Hidden = True
  Rows("7:500").Hidden = True
  eing = InputBox(" spalte?")
  Columns(eing).Hidden = False
  P = Columns(eing).Column
  For Each Zelle In Range(Cells(7, P), Cells(500, P)).Cells
    If Not IsNumeric(Zelle.Value) And Not IsEmpty(Zelle.Value) Then
      Rows(Zelle.Row).EntireRow.Hidden = False
    End If
  Next Zelle
End Sub

Gruß aus'm Pott
Udo
http://www.excelerator.de

P.S. Das Forum lebt auch von den Rückmeldungen der Frager an die Antworter!


Bild


Betrifft: AW: Makro ist unerträglich langsam
von: Nayus
Geschrieben am: 06.11.2003 15:19:15

Die vielen "if"s lassen sich auch so auflösen:

Function getColumnNumber(PColumn As String) As Integer
Dim l_ret As Integer
If Len(PColumn) = 1 Then
l_ret = Asc(PColumn) - 64
ElseIf Len(PColumn) = 2 Then
l_ret = 26 + (Asc(Mid(PColumn, 1, 1)) - 65) * 26 + Asc(Mid(PColumn, 2, 1)) - 64
If l_ret > 101 Then
l_ret = 0
End If
Else
getColumnNumber = 0
End If
getColumnNumber = l_ret
End Function



Private Sub Start_report_Click()
Dim r, o, p, u, v
Dim eing
Dim s As Integer
Dim zelle As Range
Dim rng As Range
  
  Application.ScreenUpdating = False
  
  Rows("7:500").Select   'hiermit werden ganze zeilen selektiert
  Selection.EntireRow.Hidden = True  'die selektion ausblenden
  
  Columns("I:CW").Select 'Spalten selektieren
  Selection.EntireColumn.Hidden = True 'Selektion ausblenden
  eing = InputBox("Bitte die Spalte angeben, für die ein Report erzeugt werden soll. Zum Beispiel , , , usw.", "Zellenauswahl")
  
  p = getColumnNumber(UCase(eing))
  if p > 0 then
     Columns(UCase(eing)).Select
        Selection.EntireColumn.Hidden = False
        For r = 7 To 500
         Cells(r, p).Select
         For Each zelle In Selection
           If Not IsNumeric(zelle.Value) And Not IsEmpty(zelle.Value) Then
             Rows(r).Select
             Selection.EntireRow.Hidden = False
           End If
         Next zelle
        Next r
    
      Range("A1").Select
      Set rng = Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
      sFile = Cells(1, p)
      rFile = Cells(4, p)
      Workbooks.Add
      Range.Copy Range("A1")
      'ActiveWorkbook.SaveAs "Reporting " & sFile & "." & rFile & ".xls"
      'ActiveWorkbook.Close savechanges:=True
      Application.ScreenUpdating = True
      Range("A1").Select
  end if
  Application.ScreenUpdating = False
  if p > 0 then
     MsgBox "Reporting gespeichert!"
  else
     MsgBox "Ungültige Spalte angegeben!"
  end if
End Sub



Bild


Betrifft: AW: Makro ist unerträglich langsam
von: Hendrik
Geschrieben am: 07.11.2003 10:19:34

Hallo
vielen Dank für eure Hilfe, es hat geklappt.
Nur ein kleines Problem noch.
Nur die sichtbaren Zeilen sollen in eine neue Arbeitsmappe kopiert werden.
Habe dazu folgende Befehle benutzt:

Set rng = Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
Workbooks.Add
rng.copy Range("A1")

geht aber nicht?

Gruß
Hendrik


Bild


Betrifft: Fehler nicht nachvollziehbar
von: Martin Beck
Geschrieben am: 07.11.2003 15:39:37

Hallo Hendrik,

ich habe das gerade getestet, funktioniert einwandfrei, wenn die Tabelle aktiv ist, aus der heraus kopiert werden soll. Vielleicht postest Du mal den kompletten Code.

Gruß
Martin Beck


Bild

Beiträge aus den Excel-Beispielen zum Thema " Makro ist unerträglich langsam"