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