Clever-Excel-Forum

Hallo,

Dank eurer Hilfe habe ich diese Tabelle erstellt, leider ist diese so groß geworden (und wird noch größer) das ich eine Fehlermeldung erhalte.
In den Reiter Textil schreibe ich ein Datum und in dem Verlauf werden die entsprechenen Daten übertragen immer in die nächste frei Spalte.
Läuft super, jetzt erscheint nach weiteren Einträgen "Prozedur zu groß". Ich habe schon im Netz nach Lösungen gesucht, ich habe nichts gefunden
was mir hilft. Der "Call" Eintrag soll helfen aber wo und wie??
Kann der Fehler am Sub Worksheet_Change(ByVal Target As Range) liegen?
Meine VBA Kenntnisse sind nicht besonders gut, nur mit eurer Hilfe bin ich soweit gekommen.
Dankeschön im Voraus.

Hi,

(05.02.2015, 16:16)tomdaggi schrieb: [ -> ]Kann der Fehler am Sub Worksheet_Change(ByVal Target As Range) liegen?
Meine VBA Kenntnisse sind nicht besonders gut, nur mit eurer Hilfe bin ich soweit gekommen.

leider kann nicht richtig getestet werden, da der Blattschutz passwortgeschützt ist.

Sorry habe ich vergessen, test ist das Kennwort

Hallo,

da warst Du aber sehr fleißig. wahrscheinlich wolltest Du für die Konstellation True True noch mehr Code schreiben. Wenn ja, dann melde Dich noch einmal.

Ansonsten müsste Dein Code-"Roman" so zusammengekürzt werden können:

Hallo noch mal,

so wie ich sehe müsste sogar das reichen:

Hallo,

Da war ja 5 mal dasselbe drin.
Teste mal das:


Gruß Uwe

Hi

dann will ich doch auch meinen Senf dazugeben

Sub Worksheet_Change(ByVal Target As Range)

   Dim ws As Worksheet, lLastRow As Long

   

   If Not Intersect(Target, Union(Range("B6:D9"), Range("B12:D15"), Range("B18:D22"), Range("B25:D27"))) Is Nothing Then

      If Year(Target.Value) <= 2013 Then Exit Sub

      

      If CheckBox1 = False And CheckBox2 = False Then

         Set ws = Worksheets("Verlauf 3Monate")

      ElseIf CheckBox1 = True And CheckBox2 = False Then

         Set ws = Worksheets("Verlauf 1.Jahr")

      ElseIf CheckBox1 = True And CheckBox2 = True Then

         Set ws = Worksheets("Verlauf 2.Jahr")

      End If

      

      lLastRow = ws.Range("A10000").End(xlUp).Row + 1

      ws.Cells(lLastRow, 3).Value = _

          Range("C3") & (" / ") & Range("A5").Text & (": ") & Range("A6").Text & (" kann ") & Range("B3").Text & (" ") & Range("A3").Text

      ws.Cells(lLastRow, 1).Value = Target.Value

      ws.Cells(lLastRow, 2).Value = "1"

   End If

End Sub

Mal nur ein Hinweis, Leute;
eine Notation wie CheckBox1 = False And CheckBox2 = False ist nicht gerade professionell, da der Wert einer CheckBox ohnehin schon ein Boolescher ist. Da kann dann im erwünschten True-Fall das = True entfallen und im False-Fall schreibt man Not CheckBox1, im o.g. Fall also Not (CheckBox1 Or CheckBox2).
Gruß, Luc

Wow, das geht aber schnell, wie saugt man sich so schnell den Code aus den Fingern?

Ja, Uwe du hast Recht, als ich die doppelten Einträge anpassen wollte ist mir die
Fehlermeldung aufgefallen.

Also erstmals herzlichen Dank an alle, ich bin begeistert.
Ich werde alle Beiträge Morgen erst testen können.
Bei weiteren Rückfragen möchte ich gerne auf eure Kompetenz zurückgreifen.

Hallo,

Für mich stellt sich das so dar: