Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1408to1412
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

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
Anzeige
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

Anzeige
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

Anzeige
Suche getMoreSpeed in der Recherche! (owT)
20.02.2015 15:57:58
EtoPHG

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige