Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1632to1636
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
Inhaltsverzeichnis

Code sehr langsam - Array verwenden?

Code sehr langsam - Array verwenden?
04.07.2018 12:00:48
Georg
Liebe Mitglieder,
der Code weiter unten ist sehr langsam und umständlich. Leider kann ich es (noch) nicht besser.
Die Datei hat drei Blätter für die Adminsachen, dann 80 blätter die alle identisch aufgebaut sind.
Zusammenfassung was hier passiert:
1. über Input-Box wird ein Name eingegeben, z. B. Dortmund, das Blatt "Musterpraxis"wird dupliziert und zu Dortmund_2019 umbenannt, dann werden alte Daten aus dem Blatt Dortmund_2018 zu Dortmund_2019 kopiert.
2. Sobald dies abgeschlossen ist, werden zwei Übersichtsblätter mit den Daten aus Dortmund 2019 befüllt.
3. Im Anschluss wird das alte Blatt ...2018 gelöscht.
Die Eingabe 80x über Input Box ist natürlich sehr umständlich. Gibt es eine Möglichkeit, dies zu beschleunigen, in dem Sinne, dass die Übernahme der alten Daten für jedes worksheet von 3 bis 80 geht ohne Inputbox? Die Namenskonvention ist immer identisch: Städtename_2018
Es werden über eine Index Formel (hat nix direkt mit dem Code zu tun)
(=WENNFEHLER(INDEX(MatrixSchichtMuster;VERGLEICH($C$18&$E41;TabMuster&TabSchichtBez;0);VERGLEICH(S$4;TabWochentage;0))*S$5*$F41;0)
in jedem Blatt ab sheet(3) (Range g6:S41)
Werte berechnet. Ich habe den Eindruck, das macht die Sache sehr langsam, gibt es eine Alternative?
Sollte man einen Array anlegen mit den Städenamen? arr(Dortmund, München, Memmingen.....)?
Ein Grund warum ich das hier poste, ist, ich muss es nochmal durchführen und möchte es
a) beschleunigen und b) noch etwas dazulernen.
Für jeden Tipp bin ich dankbar.
Option Explicit

Sub PersPlanung2019()
Dim Px As String
Px = Application.InputBox("Praxisname eingeben", "BPx")
Dim j As Integer
j = 2018
Dim PlJahr As Integer
PlJahr = 2019
Dim PxAlt As String
PxAlt = Px & "_" & j
Dim PxNeu As String
PxNeu = Px & "_" & j + 1
Dim BPxRegion As String
'Sheet Musterpraxis wird kopiert und es wird eine konkretes Blatt für eine BPx erzeugt
Sheets(1).Select
Sheets(1).Copy after:=Sheets(1) 'also z. B. Memmingen 2019 steht an Position 2
Sheets(2).Activate
ActiveSheet.Name = Px & "_" & j + 1
'Jetzt habe ich zwei: BPx Praxisname 2018 und 2019
'Jetzt sollen die Werte von 2018 übernommen werden.
With Sheets(2)
.Cells(15, 3) = Px                                          'Praxisname
.Cells(16, 3) = ThisWorkbook.Worksheets(PxAlt).Cells(16, 3) 'Kostenstelle
.Cells(16, 3).NumberFormat = "00000"
.Cells(17, 3) = ThisWorkbook.Worksheets(PxAlt).Cells(17, 3) 'in Betrieb
.Cells(18, 3) = ThisWorkbook.Worksheets(PxAlt).Cells(18, 3) 'Schichtmuster
.Cells(30, 3) = ThisWorkbook.Worksheets(PxAlt).Cells(30, 3) 'TZ Kraft 1
.Cells(32, 3) = ThisWorkbook.Worksheets(PxAlt).Cells(32, 3) 'TZ Kraft 2
.Cells(34, 3) = ThisWorkbook.Worksheets(PxAlt).Cells(34, 3) 'TZ Kraft 3
.Cells(43, 3) = ThisWorkbook.Worksheets(PxAlt).Cells(43, 3) 'durchschn. h gfB
.Cells(50, 3) = ThisWorkbook.Worksheets(PxAlt).Cells(50, 3) 'Ist Köpfe TZ
.Cells(51, 3) = ThisWorkbook.Worksheets(PxAlt).Cells(51, 3) 'Ist Köpfe gfB
.Cells(2, 2).Value = "Planung für: BPx " & Px & "_" & PlJahr
.Buttons(1).Name = "Praxis"
.Buttons("Praxis").Delete
End With
BPxRegion = Application.InputBox("Region eingeben", "BPxRegion")
'Das Blatt BPxÜbersicht wird befüllt:
Sheets("BPxÜbersicht").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0) = BPxRegion
Sheets("BPxÜbersicht").Cells(Rows.Count, 3).End(xlUp).Offset(1, 0) = Px & "_" & PlJahr
Sheets("BPxÜbersicht").Cells(Rows.Count, 4).End(xlUp).Offset(1, 0) = ThisWorkbook.Worksheets( _
PxAlt).Cells(17, 3) 'in Betrieb
Sheets("BPxÜbersicht").Cells(Rows.Count, 5).End(xlUp).Offset(1, 0) = ThisWorkbook.Worksheets( _
PxAlt).Cells(16, 3) 'Kostenstelle
'Soll Köpfe TZ
Sheets("BPxÜbersicht").Cells(Rows.Count, 6).End(xlUp).Offset(1, 0).FormulaLocal = _
"='" & Px & "_" & PlJahr & "'!C37"
'Ist Köpfe TZ
Sheets("BPxÜbersicht").Cells(Rows.Count, 7).End(xlUp).Offset(1, 0).FormulaLocal = _
"='" & Px & "_" & PlJahr & "'!C50"
'Soll Köpfe TZ in FTE
Sheets("BPxÜbersicht").Cells(Rows.Count, 8).End(xlUp).Offset(1, 0).FormulaLocal = _
"='" & Px & "_" & PlJahr & "'!C38"
'IST Köpfe TZ in FTE
Sheets("BPxÜbersicht").Cells(Rows.Count, 9).End(xlUp).Offset(1, 0).FormulaLocal = _
"='" & Px & "_" & PlJahr & "'!C52"
'Soll Köpfe gfB
Sheets("BPxÜbersicht").Cells(Rows.Count, 10).End(xlUp).Offset(1, 0).FormulaLocal = _
"='" & Px & "_" & PlJahr & "'!C44"
'Ist Köpfe gfB
Sheets("BPxÜbersicht").Cells(Rows.Count, 11).End(xlUp).Offset(1, 0).FormulaLocal = _
"='" & Px & "_" & PlJahr & "'!C51"
'Soll gfB FTE
Sheets("BPxÜbersicht").Cells(Rows.Count, 12).End(xlUp).Offset(1, 0).FormulaLocal = _
"='" & Px & "_" & PlJahr & "'!C45"
'IST gfB FTE
Sheets("BPxÜbersicht").Cells(Rows.Count, 13).End(xlUp).Offset(1, 0).FormulaLocal = _
"='" & Px & "_" & PlJahr & "'!C53"
'SOLL Köpfe Gesamt
Sheets("BPxÜbersicht").Cells(Rows.Count, 14).End(xlUp).Offset(1, 0).FormulaLocal = _
"='" & Px & "_" & PlJahr & "'!C47"
'IST Köpfe GESAMT
Sheets("BPxÜbersicht").Cells(Rows.Count, 15).End(xlUp).Offset(1, 0).FormulaLocal = _
"='" & Px & "_" & PlJahr & "'!C54"
'Soll FTE Gesamt
Sheets("BPxÜbersicht").Cells(Rows.Count, 18).End(xlUp).Offset(1, 0).FormulaLocal = _
"='" & Px & "_" & PlJahr & "'!C48"
'Ist FTE
Sheets("BPxÜbersicht").Cells(Rows.Count, 19).End(xlUp).Offset(1, 0).FormulaLocal = _
"='" & Px & "_" & PlJahr & "'!C55"
'Neues Sheet verschieben
Sheets(2).Move after:=Sheets("Controlling")
'Controlling Blatt befüllen
Sheets("Controlling").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0) = BPxRegion
Sheets("Controlling").Cells(Rows.Count, 3).End(xlUp).Offset(1, 0) = PxNeu
Sheets("Controlling").Cells(Rows.Count, 4).End(xlUp).Offset(1, 0) = ThisWorkbook.Worksheets( _
PxNeu).Cells(17, 3) 'in Betrieb
Sheets("Controlling").Cells(Rows.Count, 5).End(xlUp).Offset(1, 0) = ThisWorkbook.Worksheets( _
PxNeu).Cells(16, 3) 'Kostenstelle
ThisWorkbook.Worksheets(PxNeu).Cells(16, 3).NumberFormat = "00000"
Sheets("Controlling").Cells(Rows.Count, 6).End(xlUp).Offset(1, 0) = ThisWorkbook.Worksheets( _
PxNeu).Cells(27, 3) 'Gesamtstunden
Sheets("Controlling").Cells(Rows.Count, 7).End(xlUp).Offset(1, 0) = ThisWorkbook.Worksheets( _
PxNeu).Cells(47, 3) 'Soll Köpfe
Sheets("Controlling").Cells(Rows.Count, 8).End(xlUp).Offset(1, 0) = ThisWorkbook.Worksheets( _
PxNeu).Cells(48, 3) 'Soll FTE
Sheets("Controlling").Cells(Rows.Count, 10).End(xlUp).Offset(1, 0) = ThisWorkbook.Worksheets( _
PxNeu).Cells(54, 3) 'IST Köpfe
Sheets("Controlling").Cells(Rows.Count, 11).End(xlUp).Offset(1, 0) = ThisWorkbook.Worksheets( _
PxNeu).Cells(55, 3) 'IST FTE
'2018 Blatt löschen ohne Nachzufragen
Application.DisplayAlerts = False
Worksheets(PxAlt).Delete
Application.DisplayAlerts = True
'Call BlätterSortieren
End Sub

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Bitte diesen Post ignorieren!!
04.07.2018 12:03:30
Georg
wg Netzwerkwackler 2 mal drin
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige