Optimierung Code

Sub beim_speichern() x = 7 Do While Cells(x, 7).Value "" Cells(x, 6).Value = Cells(x, 3).Value + Cells(x, 4).Value + Cells(x, 5).Value Cells(x, 14) = Replace(Cells(x, 15).Value, " ", "", , 5) Cells(x, 12) = Right(Cells(x, 14).Text, Len(Cells(x, 14).Text) - 1) + Cells(x, 17) x = x + 1 Loop ActiveWorkbook.SaveAs Filename:="\\server\ Test.xls" End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub beim_speichern() Dim x As Long Dim oldCalc As XlCalculation Dim datStart As Date datStart = Now oldCalc = Application.Calculation Application.Calculation = xlCalculationManual Application.ScreenUpdating = False x = 7 Do While Cells(x, 7).Value "" Cells(x, 6).Value = Cells(x, 3).Value + Cells(x, 4).Value + Cells(x, 5).Value Cells(x, 14) = Replace(Cells(x, 15).Value, " ", "", , 5) Cells(x, 12) = Right(Cells(x, 14).Text, Len(Cells(x, 14).Text) - 1) + Cells(x, 17) x = x + 1 Loop Application.ScreenUpdating = True Application.Calculation = oldCalc 'ActiveWorkbook.SaveAs Filename:="\\server\ Test.xls" MsgBox Format(Now - datStart, "hh:mm:ss"), , "" End Sub

Hallo D,
beim deinem Code gibt es nicht viel zu verbessern - vielleicht folgende Details...
Ich glaube, was am meisten beschleunigt ist '.ScreenUpdating=false', ggf. noch .Calculation = xlManual!
(Tipp: Variablen IMMER deklarieren. Variablen niemals mit nur einem Buchstaben benennen - die kann man bei einer Fehlersuche nie finden, weil die Einzelbuchstaben auch in verschiedenen Wörtern vorkommen ... Besser noch benennen nach den RVBA Naming Conventions - bei Long also lngXX - siehe http://www.xoc.net/standards/rvbanc.asp]

Option Explicit 'Erzwingt Variablendeklaration
Sub beim_speichern()
Dim lngXX As Long
With Application
.ScreenUpdating = False
.Calculation = xlManual
End With
lngXX = 7
Do While Len(Cells(lngXX , 7)) > 0
Cells(lngXX, 6) = Cells(lngXX, 3) + Cells(lngXX, 4) + Cells(lngXX, 5)
Cells(lngXX, 14) = Replace(Cells(lngXX, 15).Value, " ", "", , 5)
Cells(lngXX, 12) = Val(Mid$(Cells(lngXX, 14), 2)) + Cells(lngXX, 17)
lngXX = lngXX + 1
Loop
With Application
.Calculation = xlAutomatic
.Calculate
.ScreenUpdating = True
End With
ActiveWorkbook.SaveAs Filename:="\\server\ Test.xls"
End Sub

Was du da beim Speichern machen willst, habe ich nicht kapiert.
Wenn du etwas automatisch beim Abspeichern ausführen willst, musst du das als

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
End Sub

in 'Diese Arbeitsmappe' stellen.
Greetz, Peter

HI
was steht denn in der Zelle drin ?
"+" steht hier für das Addtionszeichen.
Weil der Wert vor dem Plus eine Zahl ist (VAL) versucht VBA die beiden Zahlen zusammenzuaddieren und erzeugt einen Fehlerabbruch, wenn der zweite Wert ein Text ist, welcher auch nicht in eine Zahl gewandelt werden kann.
wenn du Addieren willst, könnstest mit Worksheetfunction.Sum arbeiten, weil die Summenfunktion Textwerte ignoriert:
Cells(lngXX, 12) = Worksheetfunction.Sum(Val(Mid$(Cells(lngXX, 14), 2)), Cells(lngXX, 17))
möchstest du jedoch zwei Texte zusammenfügen, solltest du nicht das "+" verwenden, sondern das "&", denn dann wird immer zusammengefügt, auch wenn die Werte Zahlen sind.
Cells(lngXX, 12) = Val(Mid$(Cells(lngXX, 14), 2)) & Cells(lngXX, 17)
Gruss Daniel

Beliebteste Forumthreads (12 Monate)

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread