Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
332to336
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
332to336
332to336
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Makro ist unerträglich langsam

Makro ist unerträglich langsam
06.11.2003 14:31:07
Hendrik
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

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro ist unerträglich langsam
06.11.2003 14:43:09
Michael Scheffler
Hallo,

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

Gruß

Micha
AW: Makro ist unerträglich langsam
06.11.2003 15:04:31
Jens
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.
Anzeige
AW: Makro ist unerträglich langsam
06.11.2003 15:07:34
xXx
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!
Anzeige
AW: Makro ist unerträglich langsam
06.11.2003 15:19:15
Nayus
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

Anzeige
AW: Makro ist unerträglich langsam
07.11.2003 10:19:34
Hendrik
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
Fehler nicht nachvollziehbar
07.11.2003 15:39:37
Martin Beck
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
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige