optimieren

Forumthread: optimieren

optimieren

20.02.2015 12:54:55

Tina

Hallo,
ich hoffe, dass es eine Möglichkeit gibt meinen VBA Text zu optimieren, da das Ausführen doch sehr lange dauert.
Ich habe 11 Dateien in denen Mitarbeiter ihre Statistik führen. Einmal im Monat hole ich mir die Daten und fasse sie in einer Datei zusammen.
Ist mein VBA Test zu kompliziert? Gibt es eine Möglichkeit, das Ganze zu verkürzen damit es schneller wird?
Ich freue mich über jeden Tipp :o)
LG
Tina

Private Sub OK_Click()
Dim n%
Application.ScreenUpdating = False
'alle Flest Dateien öffnen
For n = 1 To 11
Workbooks.Open (ThisWorkbook.Path & "\Flest" & Format(n, "000") & ".xlsm")
'Anmeldung E
Tabelle2.Cells(7, Monate.ListIndex + 2).Value = Tabelle2.Cells(7, Monate.ListIndex + 2).Value +  _
WorksheetFunction.Sum(Worksheets(Monate.ListIndex + 1).Range("B4:AA4"))
Tabelle2.Cells(8, Monate.ListIndex + 2).Value = Tabelle2.Cells(8, Monate.ListIndex + 2).Value +  _
WorksheetFunction.Sum(Worksheets(Monate.ListIndex + 1).Range("B5:AA5"))
Tabelle2.Cells(9, Monate.ListIndex + 2).Value = Tabelle2.Cells(9, Monate.ListIndex + 2).Value +  _
WorksheetFunction.Sum(Worksheets(Monate.ListIndex + 1).Range("B6:AA6"))
Tabelle2.Cells(10, Monate.ListIndex + 2).Value = Tabelle2.Cells(10, Monate.ListIndex + 2).Value  _
+ WorksheetFunction.Sum(Worksheets(Monate.ListIndex + 1).Range("B7:AA7"))
Tabelle2.Cells(11, Monate.ListIndex + 2).Value = Tabelle2.Cells(11, Monate.ListIndex + 2).Value  _
+ WorksheetFunction.Sum(Worksheets(Monate.ListIndex + 1).Range("B8:AA9"))
Tabelle2.Cells(12, Monate.ListIndex + 2).Value = Tabelle2.Cells(12, Monate.ListIndex + 2).Value  _
+ WorksheetFunction.Sum(Worksheets(Monate.ListIndex + 1).Range("B9:AA9"))
Tabelle2.Cells(13, Monate.ListIndex + 2).Value = Tabelle2.Cells(13, Monate.ListIndex + 2).Value  _
+ WorksheetFunction.Sum(Worksheets(Monate.ListIndex + 1).Range("B10:AA10"))
'Anmeldung L
Tabelle2.Cells(18, Monate.ListIndex + 2).Value = Tabelle2.Cells(18, Monate.ListIndex + 2).Value  _
+ WorksheetFunction.Sum(Worksheets(Monate.ListIndex + 1).Range("B12:AA12"))
Tabelle2.Cells(19, Monate.ListIndex + 2).Value = Tabelle2.Cells(19, Monate.ListIndex + 2).Value  _
+ WorksheetFunction.Sum(Worksheets(Monate.ListIndex + 1).Range("B13:AA13"))
Tabelle2.Cells(20, Monate.ListIndex + 2).Value = Tabelle2.Cells(20, Monate.ListIndex + 2).Value  _
+ WorksheetFunction.Sum(Worksheets(Monate.ListIndex + 1).Range("B14:AA14"))
Tabelle2.Cells(21, Monate.ListIndex + 2).Value = Tabelle2.Cells(21, Monate.ListIndex + 2).Value  _
+ WorksheetFunction.Sum(Worksheets(Monate.ListIndex + 1).Range("B15:AA15"))
Tabelle2.Cells(22, Monate.ListIndex + 2).Value = Tabelle2.Cells(22, Monate.ListIndex + 2).Value  _
+ WorksheetFunction.Sum(Worksheets(Monate.ListIndex + 1).Range("B16:AA16"))
Tabelle2.Cells(23, Monate.ListIndex + 2).Value = Tabelle2.Cells(23, Monate.ListIndex + 2).Value  _
+ WorksheetFunction.Sum(Worksheets(Monate.ListIndex + 1).Range("B17:AA17"))
Tabelle2.Cells(24, Monate.ListIndex + 2).Value = Tabelle2.Cells(24, Monate.ListIndex + 2).Value  _
+ WorksheetFunction.Sum(Worksheets(Monate.ListIndex + 1).Range("B18:AA18"))
'Erm.
Tabelle2.Cells(26, Monate.ListIndex + 2).Value = Tabelle2.Cells(26, Monate.ListIndex + 2).Value  _
+ WorksheetFunction.Sum(Worksheets(Monate.ListIndex + 1).Range("B20:AA20"))
Tabelle2.Cells(27, Monate.ListIndex + 2).Value = Tabelle2.Cells(27, Monate.ListIndex + 2).Value  _
+ WorksheetFunction.Sum(Worksheets(Monate.ListIndex + 1).Range("B21:AA21"))
'Nachb.
Tabelle2.Cells(28, Monate.ListIndex + 2).Value = Tabelle2.Cells(28, Monate.ListIndex + 2).Value  _
+ WorksheetFunction.Sum(Worksheets(Monate.ListIndex + 1).Range("B22:AA22"))
'Ausk.
Tabelle2.Cells(30, Monate.ListIndex + 2).Value = Tabelle2.Cells(30, Monate.ListIndex + 2).Value  _
+ WorksheetFunction.Sum(Worksheets(Monate.ListIndex + 1).Range("B24:AA24"))
Tabelle2.Cells(31, Monate.ListIndex + 2).Value = Tabelle2.Cells(31, Monate.ListIndex + 2).Value  _
+ WorksheetFunction.Sum(Worksheets(Monate.ListIndex + 1).Range("B25:AA25"))
Tabelle2.Cells(32, Monate.ListIndex + 2).Value = Tabelle2.Cells(32, Monate.ListIndex + 2).Value  _
+ WorksheetFunction.Sum(Worksheets(Monate.ListIndex + 1).Range("B26:AA26"))
Tabelle2.Cells(33, Monate.ListIndex + 2).Value = Tabelle2.Cells(33, Monate.ListIndex + 2).Value  _
+ WorksheetFunction.Sum(Worksheets(Monate.ListIndex + 1).Range("B27:AA27"))
Tabelle2.Cells(34, Monate.ListIndex + 2).Value = Tabelle2.Cells(34, Monate.ListIndex + 2).Value  _
+ WorksheetFunction.Sum(Worksheets(Monate.ListIndex + 1).Range("B28:AA28"))
Tabelle2.Cells(35, Monate.ListIndex + 2).Value = Tabelle2.Cells(35, Monate.ListIndex + 2).Value  _
+ WorksheetFunction.Sum(Worksheets(Monate.ListIndex + 1).Range("B29:AA29"))
Workbooks("Flest" & Format(n, "000") & ".xlsm").Close
Next n
Application.ScreenUpdating = True
MsgBox "Fertig"
Unload Me
End Sub

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: optimieren

20.02.2015 13:51:02

Rudi
AW: optimieren

20.02.2015 14:16:28

Tina
Suche getMoreSpeed in der Recherche! (owT)

20.02.2015 15:57:58

EtoPHG

AW: optimieren

20.02.2015 13:51:02

Rudi

hallo,
ungetestet:

Private Sub OK_Click()
Dim n%, vArr, i As Integer, lMon As Long
Dim wkb As Workbook, wks As Worksheet
Application.ScreenUpdating = False
lMon = Monate.ListIndex + 2
'alle Flest Dateien öffnen
For n = 1 To 11
Set wkb = Workbooks.Open(ThisWorkbook.Path & "\Flest" & Format(n, "000") & ".xlsm")
Set wks = wkb.Sheets(lMon)
With Tabelle2
'Anmeldung E
vArr = .Range(.Cells(7, lMon), .Cells(13, lMon))
For i = 4 To 10
vArr(i - 3, 1) = vArr(i - 3, 1) + WorksheetFunction.Sum(wks.Range("B" & i & ":AA" & i))
Next i
.Range(.Cells(7, lMon), .Cells(13, lMon)) = vArr
'Anmeldung L
vArr = .Range(.Cells(18, lMon), .Cells(24, lMon))
For i = 12 To 18
vArr(i - 11, 1) = vArr(i - 11, 1) + WorksheetFunction.Sum(wks.Range("B" & i & ":AA" & i))
Next i
.Range(.Cells(18, lMon), .Cells(24, lMon)) = vArr
'Erm.
.Cells(26, lMon).Value = .Cells(26, lMon).Value _
+ WorksheetFunction.Sum(wks.Range("B20:AA20"))
.Cells(27, lMon).Value = .Cells(27, lMon).Value _
+ WorksheetFunction.Sum(wks.Range("B21:AA21"))
'Nachb.
.Cells(28, lMon).Value = .Cells(28, lMon).Value _
+ WorksheetFunction.Sum(wks.Range("B22:AA22"))
'Ausk.
vArr = .Range(.Cells(30, lMon), .Cells(35, lMon))
For i = 24 To 29
vArr(i - 23, 1) = vArr(i - 23, 1) + WorksheetFunction.Sum(wks.Range("B" & i & ":AA" & i))
Next i
.Range(.Cells(30, lMon), .Cells(35, lMon)) = vArr
End With
wkb.Close
Next n
Application.ScreenUpdating = True
MsgBox "Fertig"
Unload Me
End Sub

Gruß
Rudi

AW: optimieren

20.02.2015 14:16:28

Tina

Hallo Rudi,
dein Text ist auf jeden Fall professioneller geschrieben (aber irgendwo ist noch ein kleiner Haken, weil das Ergebnis nicht ganz hinhaut, das wäre aber kein Problem)
Allerdings ist es so auch nicht schneller, ich habe extra die Zeit gestoppt, das Makro läuft genau so schnell wie meins. Gibt's da vielleicht noch eine Idee?
Dies ist nur ein Teil des Makros, eigentlich ist es 3mal so lang und es läuft jetzt schon ziemlich lange. naja ist ja relativ, genau genommen sind es 15 Sek. im Moment, wenn ich also alles geschrieben habe, liege ich wohl so bei 45 Sek.
LG
Tina

Suche getMoreSpeed in der Recherche! (owT)

20.02.2015 15:57:58

EtoPHG

Beliebteste Forumthreads (12 Monate)

Forumthread: optimieren

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread