Codeoptimierung ohne Activate und Select
05.07.2013 09:06:37
Nils
ich möchte gerne folgenden Code ohne die ständigen Activate, Selects und GoTos nutzen und dementsprechend optimieren. Ich hatte gestern schon mal danach gefragt und mir wurde auch geholfen, dann habe ich wieder etwas am Code verändert und insbesondere einen Find-Befehl hinzugefügt und nun kriege ich andauernd Fehler "End With ohne With", "Next ohne For", mehrere Laufzeitfehler etc. .
Deswegen hier noch mal der ursprüngliche funktionierende Code:
Sub nils12345()
zeile = 3
lz = Sheets("Umsaetze").Cells(Rows.Count, 2).End(xlUp).Row
AktuellerMonat = Sheets("Umsaetze").Range("D1").Value
Monat = Format(AktuellerMonat, "mmmm yyyy")
Application.ScreenUpdating = False
' Erstellen eines neuen Sheets für den aktuellen Monat
ThisWorkbook.Activate
Worksheets("Monatsuebersicht").Copy After:=Worksheets("Umsaetze")
With ActiveSheet
.Name = AktuellerMonat
.Range("A4:E100").ClearContents
End With
' Definition der verschiedenen Spalten im Sheet der Umsätze
Sheets("Umsaetze").Select
For S = 5 To lz
If Cells(S, 3) = "" Then GoTo 1
Datum = Cells(S, 1)
VonAn = Cells(S + 1, 2)
Umsatz = Cells(S, 3)
Total = Cells(S, 4)
Zuo = Cells(S, 5)
' Einträge im Sheet des aktuellen Monats
ThisWorkbook.Worksheets(AktuellerMonat).Activate
Cells(zeile, 1) = Datum
Cells(zeile, 2) = VonAn
Cells(zeile, 3).FormulaLocal = Left(Umsatz, Len(Umsatz) - 4)
Cells(zeile, 4).FormulaLocal = Left(Total, Len(Total) - 4)
Cells(zeile, 5) = Zuo
' Einträge im Sheet von Horst, Peter, Werner, Alle
ThisWorkbook.Worksheets(Zuo).Activate
lszuo = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Set Findmon = Sheets(Zuo).Range(Cells(1, 1), Cells(1, lszuo)).Find(What:=Monat, LookIn:= _
xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
col = Findmon.Column
lzzuo = ActiveSheet.Cells(Rows.Count, col + 1).End(xlUp).Row
If Not Findmon Is Nothing Then
With Sheets(Zuo)
.Cells(lzzuo + 1, col + 1) = Datum
.Cells(lzzuo + 1, col + 2) = VonAn
.Cells(lzzuo + 1, col + 3).FormulaLocal = Left(Umsatz, Len(Umsatz) - 4)
End With
Else
MsgBox "Monat wurde nicht gefunden"
End If
Sheets("Umsaetze").Select
zeile = zeile + 1
1:
Next
Application.ScreenUpdating = True
Sheets(AktuellerMonat).Activate
End Sub
Wenn ihr mir noch mal helfen würdet wäre das klasse. Habe gestern auch noch mal in meinem schlauen VBA Buch über geschachtelte With gelesen und verstanden ;).