Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1320to1324
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

Codeoptimierung ohne Activate und Select

Codeoptimierung ohne Activate und Select
05.07.2013 09:06:37
Nils
Hallo zusammen,
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 ;).

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Nöööö, mach ich nicht ....
05.07.2013 09:09:02
Klaus
Hallo Nils,
du hast ja immer noch Sheets("Umsaetze").Select und Goto 1 drin. Das hatten wir doch bereits gestern eleminiert.
Grüße,
Klaus M.vdT:

Etwas bereinigt...
05.07.2013 09:26:17
JACKD
sowie ungetestet Nils.
weiteres nur mit Mappe, da ich keine Lust hab das alles nachzubauen
Grüße
Sub nils12345()
'Dimensionierung
Dim Zeile As Long
Dim LZ As Long
Dim S As Long
Dim AktuellerMonat As String
Dim Monat As String
Dim LSZuo As Integer
Dim LZZuo As Long
Dim Col As Integer
'Definitionen
Zeile = 3
LZ = Sheets("Umsaetze").Cells(Rows.Count, 2).End(xlUp).Row
AktuellerMonat = Sheets("Umsaetze").Range("D1").Value
Monat = Format(AktuellerMonat, "mmmm yyyy")
'Schnelligkeit
Application.ScreenUpdating = False
' Erstellen eines neuen Sheets für den aktuellen Monat
Worksheets("Monatsuebersicht").Copy After:=Worksheets("Umsaetze")
With ActiveSheet
On Error Resume Next
.Name = AktuellerMonat
.Range("A4:E100").ClearContents
End With
' Definition der verschiedenen Spalten im Sheet der Umsätze
With Worksheets("Umsaetze")
For S = 5 To LZ
If .Cells(S, 3) = "" Then Resume Next
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
With Worksheets(AktuellerMonat)
.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
End With
' Einträge im Sheet von Horst, Peter, Werner, Alle
With Worksheets(Zuo)
'letzte Spalte
LSZuo = .Cells(1, Columns.Count).End(xlToLeft).Column
Set Findmon = .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 = .Cells(Rows.Count, Col + 1).End(xlUp).Row
If Not Findmon Is Nothing Then
.Cells(LZZuo + 1, Col + 1) = Datum
.Cells(LZZuo + 1, Col + 2) = VonAn
.Cells(LZZuo + 1, Col + 3).FormulaLocal = Left(Umsatz, Len(Umsatz) - 4)
Else
MsgBox "Monat wurde nicht gefunden"
End If
Zeile = Zeile + 1
End With
Next S
End With
Application.ScreenUpdating = True
Worksheets(AktuellerMonat).Activate
End Sub

Anzeige
.... Then Resume Next
05.07.2013 09:28:23
Klaus
Hi JackD,
den
If .Cells(S, 3) = "" Then Resume Next
find ich echt gut! Als ich den Code gestern bereinigt habe, hab ich alles innerhalb der Schleife in einen großen IF-Block gepackt ...
Grüße,
Klaus M.vdT.

Manchmal
05.07.2013 09:31:40
JACKD
hab ich auch meine "hellen" Momente :-D
Wobei ich mit dem resume next auch so meine Schwierigkeiten hab, wenn ich drüber nachdenke =)
Grüße

AW: .... Then Resume Next
05.07.2013 10:14:47
Luschi
Hallo Klaus,
dieser Meinung kann ich mich überhaupt nicht anschließen; wie in diesem Vba-Code mit 'On Error Resume Next' umgegangen wird, ist einfach katastrophal. Das ist eine General-Amnestie für jeden auftretenden Fehler: egal was passiert, wir machen einfach weiter als ob nichts gewesen ist. Da wird mit dem Find-Befehl ein Wert gesucht und nicht sofort geprüft, ob er auch im Suchbereich vorhanden ist. Es wird einfach die Spaltennummer des (eventuell nicht) gefundenen Wertes abgefragt - 'On Error Resume Next' wird es schon richten.
Und was diese Zeile 'If .Cells(S, 3) = "" Then Resume Next' eigentlich bewirken soll, ist mit einfach schleierhaft. Es gibt keine Sprungmarke für den Fehlerfall, denn das ist die eigentliche Aufgabe dieser Anweisung. Eigentlich würde ein Vba-Fehler Nr. 20 auftreten (Resume ohne Fehler), aber die Allmacht von 'On Error Resume Next' verhindert auch das noch.
Ich denke, daß mußte mal gesagt werden und da ist kein Platz für Schulterklopferei.
Gruß von Luschi
aus klein-Paris

Anzeige
AW: .... Then Resume Next
05.07.2013 10:32:23
JACKD
Hallo Luschi.
Vielen Dank für deine Offenen Worte.
Wie du erkannt, hast, gehe ich in dem Fall sehr inflationär mit dieser Begriffszeiel um.
Warum?
Im ersten Schritt bei der erstellung des Blattes, hatte ich schlicht keine Lust was zum Fehler abfangen zu schreiben (war ja auch nicht die Aufgabe)
Beim 2. Erfüllt es genau die Bedingung, da der TE kein GoTo oder ähnliches Wollte.
insofern Quick and Dirty, wobei mehr Dirty.
Aber wenn du es schon ansprichst, würde ich gern mal nachhaken.
Du hast erwähnt, das es eine "General-Amnesie" für jeden Fehler ist.
Ist das so? Mir ist zb. nicht bewusst, wie "weit" der Befehl geht
Geht er über with Schleifen hinaus? Über IF-Blöcke?
Oder tatsächlich nur, in der "Ebene" in der er plaziert wurde?
Grüße

Anzeige
AW: .... Then Resume Next
05.07.2013 10:35:44
Nils
Danke erst mal für die Bereinigung.
Ich habe es mal durchlaufen lassen. Leider funktioniert das 'Resume Next' auch nicht.
Selbst wenn der Fall Cells(S, 3) = "" eintritt, wird nicht zum Next gesprungen.
If .Cells(S, 3) = "" Then Resume Next

Und eine grundsätzliche Frage: Warum wird das folgende "With" geschachtelt, also erst ganz am Ende wieder geschlossen? Ich nutze es doch später gar nicht mehr. Wieso nicht gleich schließen?
With Worksheets("Umsaetze")

Öffnen
05.07.2013 19:47:24
Nils
Vllt. hat ja doch noch jmd. eine Antwort für mich, was das geschachtelte With angeht :-X.
Klaus ich hatte deinen Beitrag gelesen und alles eingearbeitet, allerdings dann einige Änderungen vorgenommen und nur noch Fehlermeldungen erhalten. Deswegen habe ich hier noch mal den funktionieren alten Code gepostet. Insbesondere deine GoTo Umgehung (auch ohne Resume Next) baue ich gleich noch mal ein und schaue ob es für mich irgendwie Sinn macht. Danke noch mal.

Anzeige
Kann man machen, muss dann aber ...
05.07.2013 22:04:28
Luc:-?
…so schreiben, Nils…
    For S = 5 To LZ
With Worksheets("Umsaetze")
If .Cells(S, 3) = "" Then GoTo nx
Datum = .Cells(S, 1)
VonAn = .Cells(S + 1, 2)
Umsatz = .Cells(S, 3)
Total = .Cells(S, 4)
Zuo = .Cells(S, 5)
End With
…
nx: Next S
Das Resume Next statt des GoTo nx ist so verwendet Unsinn, da es dem Fehlerfall vorbehalten ist, hier aber normalerweise kein Fehler ensteht. Entstünde er, würde aber mit dem nächsten Befehl nach seiner Zeile fortgesetzt wdn, was genauso unsinnig wäre. Aber das hat ja bereits Luschi ausführlich kommentiert! Also entweder noch ein If … Then über alles oder eben GoTo fmarke (nx ist eine fmarke!).
Übrigens fktioniert Resume Next auch nur mit On Error Resume Next bzw innerhalb der Fehler-Behandlung oder mit If Error(…) Then Resume Next Else … zuverlässig, nicht aber bei If Not Error(…) Then Resume Next u.ä. If Not Error(…) Then sollte nie gefragt wdn!
Gruß Luc :-?

Anzeige
AW: Kann man machen, muss dann aber ...
06.07.2013 12:19:10
Nils
Funktioniert super. Hab vielen Dank!

Bitte sehr! Gruß owT
06.07.2013 15:00:21
Luc:-?
:-?

AW: Kann man machen, muss dann aber ...
06.07.2013 15:03:47
Nils
Funktioniert super. Hab vielen Dank!

286 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige