Thema Datum  Von Nutzer Rating
Antwort
Rot Laufzeitproblem
28.07.2015 08:09:08 Christoph
NotSolved

Ansicht des Beitrags:
Von:
Christoph
Datum:
28.07.2015 08:09:08
Views:
1938
Rating: Antwort:
  Ja
Thema:
Laufzeitproblem
Hallo Gemeinde,
 
für die Auswertung von Verbandbucheinträgen bzw. deren Visualisieren verwende ich mehrere PivotTabellen, die wiederum die Datenbasis für meine PivotCharts bilden. Ferne verwende ich drei Kombinationsfelder, mit deren Auswahl ich die Filter der obig genannten PivotTabellen bestimme. Das Makro, welches ich programmiert habe, erfüllt seinen Dienst, d.h. die Funktionalität ist gegeben. Allerdings habe ich eine extrem lange Laufzeit. Könnt Ihr mir hier bitte weiterhelfen?
 
a) Wie kann ich den Code schlanker gestalten, sodass die Laufzeit verkürzt wird?
b) Falls a) nicht funktioniert, wie kann eine Art "Fortschrittsbalken" integriert werden, welcher die verbleibende Dauer anzeigt?
 
Nachfolgend der Code! Vielen Dank vorab für eure Unterstützung!
 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
Sub AuswahlBereich()
 
'Auswaehlen des gewuenschten Bereiches
Dim strAktuellerBereich As String
strAktuellerBereich = ThisWorkbook.Worksheets("Auswahlhilfe").Cells(26, 4).Value
 
 
    'Wenn aktuell ausgewaehlter Bereich ist gleich GERLACH GESAMT oder LEER dann
    If strAktuellerBereich = ThisWorkbook.Worksheets("Auswahlhilfe").Cells(29, 5) Or strAktuellerBereich = "" Then
        
        With ThisWorkbook.Worksheets("Automatisationshilfe").PivotTables("pvtUnfallortAbteilung")
         
            'Alle Filter loeschen, Aktualisieren, Leere Zeilen Filtern
            .PivotFields("Unfallort - Abteilung").ClearAllFilters
            .PivotCache.Refresh
            .PivotFields("Unfallort - Abteilung").PivotItems("(blank)").Visible = False
             
            'Alle Abteilungen auswaehlen
            .PivotFields("Unfallort - Bereich").CurrentPage = "(All)"
             
        End With
             
        With ThisWorkbook.Worksheets("Automatisationshilfe")
         
            .PivotTables("pvtUnfallortBereich").PivotCache.Refresh
         
            .PivotTables("pvtKlassifizierung").PivotCache.Refresh
            .PivotTables("pvtKlassifizierung").PivotFields("Unfallort - Bereich").CurrentPage = "(All)"
            .PivotTables("pvtKlassifizierung").PivotFields("Unfallort - Abteilung").CurrentPage = "(All)"
            .PivotTables("pvtKlassifizierung").PivotFields("Unfallort - Arbeitsplatz").CurrentPage = "(All)"
                    
            .PivotTables("pvtUnfallortArbeitsplatz").PivotCache.Refresh
            .PivotTables("pvtUnfallortArbeitsplatz").PivotFields("Unfallort - Bereich").CurrentPage = "(All)"
            .PivotTables("pvtUnfallortArbeitsplatz").PivotFields("Unfallort - Abteilung").CurrentPage = "(All)"
             
            .PivotTables("pvtVerletzungsart").PivotCache.Refresh
            .PivotTables("pvtVerletzungsart").PivotFields("Unfallort - Bereich").CurrentPage = "(All)"
            .PivotTables("pvtVerletzungsart").PivotFields("Unfallort - Abteilung").CurrentPage = "(All)"
            .PivotTables("pvtVerletzungsart").PivotFields("Unfallort - Arbeitsplatz").CurrentPage = "(All)"
             
            .PivotTables("pvtUnfallzeitMonat").PivotCache.Refresh
            .PivotTables("pvtUnfallzeitMonat").PivotFields("Unfallort - Bereich").CurrentPage = "(All)"
            .PivotTables("pvtUnfallzeitMonat").PivotFields("Unfallort - Abteilung").CurrentPage = "(All)"
            .PivotTables("pvtUnfallzeitMonat").PivotFields("Unfallort - Arbeitsplatz").CurrentPage = "(All)"
         
            .PivotTables("pvtUnfallzeitWochentag").PivotCache.Refresh
            .PivotTables("pvtUnfallzeitWochentag").PivotFields("Unfallort - Bereich").CurrentPage = "(All)"
            .PivotTables("pvtUnfallzeitWochentag").PivotFields("Unfallort - Abteilung").CurrentPage = "(All)"
            .PivotTables("pvtUnfallzeitWochentag").PivotFields("Unfallort - Arbeitsplatz").CurrentPage = "(All)"
         
            .PivotTables("pvtUnfallzeitSchichten").PivotCache.Refresh
            .PivotTables("pvtUnfallzeitSchichten").PivotFields("Unfallort - Bereich").CurrentPage = "(All)"
            .PivotTables("pvtUnfallzeitSchichten").PivotFields("Unfallort - Abteilung").CurrentPage = "(All)"
            .PivotTables("pvtUnfallzeitSchichten").PivotFields("Unfallort - Arbeitsplatz").CurrentPage = "(All)"
         
            .PivotTables("pvtKoerperteil").PivotCache.Refresh
            .PivotTables("pvtKoerperteil").PivotFields("Unfallort - Bereich").CurrentPage = "(All)"
            .PivotTables("pvtKoerperteil").PivotFields("Unfallort - Abteilung").CurrentPage = "(All)"
            .PivotTables("pvtKoerperteil").PivotFields("Unfallort - Arbeitsplatz").CurrentPage = "(All)"
         
            .PivotTables("pvtUnfallortArbeitsplatzGross").PivotCache.Refresh
            .PivotTables("pvtUnfallortArbeitsplatzGross").PivotFields("Unfallort - Bereich").CurrentPage = "(All)"
            .PivotTables("pvtUnfallortArbeitsplatzGross").PivotFields("Unfallort - Abteilung").CurrentPage = "(All)"
         
        End With
         
        'Ausblenden nicht benoetigter Objekte
        With ThisWorkbook.Worksheets("Dashboard")
             
            .ChartObjects("diaUnfallortArbeitsplatz").Visible = False
            .Shapes("GrUnfallortAbteilung").Visible = False
            .Shapes("GrUnfallortArbeitsplatz").Visible = False
             
        End With
     
    'Wenn aktuell ausgewaehlter Bereich ist UNgleich GERLACH GESAMT oder LEER dann
    Else
         
        With ThisWorkbook.Worksheets("Automatisationshilfe").PivotTables("pvtUnfallortAbteilung")
         
            'Alle Filter loeschen, Aktualisieren, Leere Zeilen Filtern
            .PivotFields("Unfallort - Abteilung").ClearAllFilters
            .PivotCache.Refresh
            .PivotFields("Unfallort - Abteilung").PivotItems("(blank)").Visible = False
             
            'Alle Abteilungen auswaehlen
            .PivotFields("Unfallort - Bereich").CurrentPage = strAktuellerBereich
             
        End With
             
        With ThisWorkbook.Worksheets("Automatisationshilfe")
         
            .PivotTables("pvtUnfallortBereich").PivotCache.Refresh
         
            .PivotTables("pvtKlassifizierung").PivotCache.Refresh
            .PivotTables("pvtKlassifizierung").PivotFields("Unfallort - Bereich").CurrentPage = strAktuellerBereich
            .PivotTables("pvtKlassifizierung").PivotFields("Unfallort - Abteilung").CurrentPage = "(All)"
            .PivotTables("pvtKlassifizierung").PivotFields("Unfallort - Arbeitsplatz").CurrentPage = "(All)"
                    
            .PivotTables("pvtUnfallortArbeitsplatz").PivotCache.Refresh
            .PivotTables("pvtUnfallortArbeitsplatz").PivotFields("Unfallort - Bereich").CurrentPage = strAktuellerBereich
            .PivotTables("pvtUnfallortArbeitsplatz").PivotFields("Unfallort - Abteilung").CurrentPage = "(All)"
             
            .PivotTables("pvtVerletzungsart").PivotCache.Refresh
            .PivotTables("pvtVerletzungsart").PivotFields("Unfallort - Bereich").CurrentPage = strAktuellerBereich
            .PivotTables("pvtVerletzungsart").PivotFields("Unfallort - Abteilung").CurrentPage = "(All)"
            .PivotTables("pvtVerletzungsart").PivotFields("Unfallort - Arbeitsplatz").CurrentPage = "(All)"
             
            .PivotTables("pvtUnfallzeitMonat").PivotCache.Refresh
            .PivotTables("pvtUnfallzeitMonat").PivotFields("Unfallort - Bereich").CurrentPage = strAktuellerBereich
            .PivotTables("pvtUnfallzeitMonat").PivotFields("Unfallort - Abteilung").CurrentPage = "(All)"
            .PivotTables("pvtUnfallzeitMonat").PivotFields("Unfallort - Arbeitsplatz").CurrentPage = "(All)"
         
            .PivotTables("pvtUnfallzeitWochentag").PivotCache.Refresh
            .PivotTables("pvtUnfallzeitWochentag").PivotFields("Unfallort - Bereich").CurrentPage = strAktuellerBereich
            .PivotTables("pvtUnfallzeitWochentag").PivotFields("Unfallort - Abteilung").CurrentPage = "(All)"
            .PivotTables("pvtUnfallzeitWochentag").PivotFields("Unfallort - Arbeitsplatz").CurrentPage = "(All)"
         
            .PivotTables("pvtUnfallzeitSchichten").PivotCache.Refresh
            .PivotTables("pvtUnfallzeitSchichten").PivotFields("Unfallort - Bereich").CurrentPage = strAktuellerBereich
            .PivotTables("pvtUnfallzeitSchichten").PivotFields("Unfallort - Abteilung").CurrentPage = "(All)"
            .PivotTables("pvtUnfallzeitSchichten").PivotFields("Unfallort - Arbeitsplatz").CurrentPage = "(All)"
         
            .PivotTables("pvtKoerperteil").PivotCache.Refresh
            .PivotTables("pvtKoerperteil").PivotFields("Unfallort - Bereich").CurrentPage = strAktuellerBereich
            .PivotTables("pvtKoerperteil").PivotFields("Unfallort - Abteilung").CurrentPage = "(All)"
            .PivotTables("pvtKoerperteil").PivotFields("Unfallort - Arbeitsplatz").CurrentPage = "(All)"
         
            .PivotTables("pvtUnfallortArbeitsplatzGross").PivotCache.Refresh
            .PivotTables("pvtUnfallortArbeitsplatzGross").PivotFields("Unfallort - Bereich").CurrentPage = strAktuellerBereich
            .PivotTables("pvtUnfallortArbeitsplatzGross").PivotFields("Unfallort - Abteilung").CurrentPage = "(All)"
         
        End With
         
        'Ausblenden nicht benoetigter Objekte
        With ThisWorkbook.Worksheets("Dashboard")
             
            .ChartObjects("diaUnfallortArbeitsplatz").Visible = False
            .Shapes("GrUnfallortAbteilung").Visible = True
            .Shapes("GrUnfallortArbeitsplatz").Visible = False
             
        End With
     
        'Dropdown Abteilung auf leer setzten
        ThisWorkbook.Worksheets("Auswahlhilfe").Cells(26, 10).Value = 0
        ThisWorkbook.Worksheets("Auswahlhilfe").Cells(26, 10).Value = 0
     
    End If
 
End Sub

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Laufzeitproblem
28.07.2015 08:09:08 Christoph
NotSolved