Sub funktioniert nur manuell ausgeführt

Hallo,
da ich nun einige Zeit an diesem Problem sitze und keine Lösung finde, dachte ich mir frage ich hier um Hilfe.
Also ich habe einen Sub der beim Einfügen einer neuen Zeile in bestimmten Bereichen, diese mit entsprechenden Formeln automatisch auffüllen soll. Wenn ich in diesem Bereich eine neue Zeile einfüge und das Makro manuell starte, dann klappt auch alles wunderbar, wie ich es mir vorstelle. Der Sub macht was er soll und das sehr zügig( Schön und gut, jetzt würde ich gern auf das manuelle Ausführen verzichten.
Dafür habe ich im Arbeitsblatt-Modul folgenden Sub eingetragen:

Private Sub Worksheet_Change(ByVal Target As Range) Call InsertLine.InsertNewLine End Sub

Füge ich nun eine neue Zeile ein, dann läuft der Sub auch an. Und fügt auch die richtigen Formeln ein, allerdings braucht er dafür unglaublich lange(>25sek), zusätzlich sind alle anderen sich in der Tabelle befindlichen Werte(aus Formeln) nicht berechnet und stehen auf #WERT, beim manuellen ausführen ist dies nicht der Fall. Das lässt sich zwar durch ein Aktualisieren beheben, stört aber. Automatisch am Ende des Subs Aktualisieren funktioniert nicht bzw. liefert gleiches Ergebnis. Habt ihr eine Idee woran das liegen könnte, vor allem der große Zeitliche Unterschied? Ich bin für jede Hilfe und Anregung dankbar.
Hier auch der eigentliche Sub. Insofern gekürzt das nur eine Formel eingefügt wird, real sind es 18.

Sub InsertNewLine() Dim linecounter, areacontroller, blockcontroller As Integer Dim checkend As String linecounter = 1 areacontroller = 0 blockcontroller = 0 checkend = "empthy" Do Until StrComp(checkend, "Insert additional lines above this line only! LastBlock", _ vbTextCompare) = 0 If ThisWorkbook.Sheets("Efficiency_Status_Bid_incl_RWD").Cells(linecounter, 2)= "Insert _ additional lines below this line only!" Then areacontroller = 1 linecounter = linecounter + 1 ElseIf ThisWorkbook.Sheets("Efficiency_Status_Bid_incl_RWD").Cells(linecounter, 2) = "Insert _ additional lines above this line only!" Then areacontroller = 0 End If If areacontroller = 1 And ThisWorkbook.Sheets("Example").Cells(linecounter, 3) = "" Then ThisWorkbook.Sheets("Example").Cells(linecounter, 3).FormulaLocal = "=WENN(D" & _ linecounter & ">E" & linecounter & ";1;WENN(E" & linecounter & ">F" & linecounter & ";" & """" & _ "ERROR" & """" & ";0))" End If linecounter = linecounter + 1 checkend = ThisWorkbook.Sheets("Example").Cells(linecounter, 2).Value Loop End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi
hast du bedacht, dass die Event-Makros wie "Worksheet_Change" auch dann ausgeführt werden, wenn die Änderungen auf dem Blatt durch ein Makro ausgeführt werden?
auf diese Weise kann sich das Change-Event_Makro sogar selbst aufrufen und wenns dumm läuft, landet man in einer Endlosschleife, die nur dadurch beendet wird, dass die Internen Speicher irgendwann vollaufen.
Die Ausführung der Eventmakros kann man mit dem Befehl

Application.EnableEvents = False

verhindern, dh nach diesem Befehl werden keine Eventmakros mehr ausgeführt.
Beachte dass diese Einstellung nach Makroende erhalten bleibt, dh man am Schluss dann noch irgendwann den Befehl ausführen:

Application.EnableEvents = True

Gruß Daniel

Hi hast du bedacht, dass die Event-Makros wie "Worksheet_Change" auch dann ausgeführt werden, _ wenn die Änderungen auf dem Blatt durch ein Makro ausgeführt werden? auf diese Weise kann sich das Change-Event_Makro sogar selbst aufrufen und wenns dumm läuft, _ landet man in einer Endlosschleife, die nur dadurch beendet wird, dass die Internen Speicher irgendwann vollaufen.

Sub InsertNewFormulas() Const cstrBelow = "Insertadditional lines below this line only!" Const cstrAbove = "Insert additional lines above this line only!" Const cstrEnd = "Insert additional lines above this line only! LastBlock" Dim line As Long Dim wsStatus As Worksheet, wsExample As Worksheet line = 2 Set wsStatus = ThisWorkbook.Sheets("Efficiency_Status_Bid_incl_RWD") Set wsExample = ThisWorkbook.Sheets("Example") Do If wsExample.Cells(line, 3) = "" Then If wsStatus.Cells(line - 1, 2) = cstrBelow Then If wsStatus.Cells(line, 2) cstrAbove Then wsExample.Cells(line, 3).FormulaLocal = "=WENN(D" & line & ">E" & line & ";1;" _ & "WENN(E" & line & ">F" & line & ";" & """" & "ERROR" & """" & ";0))" End If End If End If line = line + 1 Loop Until wsExample.Cells(line, 2).Value = cstrEnd Set wsStatus = Nothing: Set wsExample = Nothing End Sub

Beliebteste Forumthreads (12 Monate)

Sub funktioniert nur manuell ausgeführt

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread