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.
(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.
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:
Code:
Sub Worksheet_Change(ByVal Target As Range)
If Target.Row > 5 Then
Select Case Target.Column
Case 2
If IsDate(Target.Text) Then
If Year(Target) >= 2013 Then
If CheckBox1 = False And CheckBox2 = False Then
Worksheets("Verlauf 3Monate").Range("C10000").End(xlUp).Offset(1, 0) = Range("C3") & (" / ") & Range("A5") & (": ") & Cells(Target.Row, 1) & (" kann ") & Range("B3") & (" ") & Range("A3")
Worksheets("Verlauf 3Monate").Range("a10000").End(xlUp).Offset(1, 0) = Cells(Target.Row, 2)
Worksheets("Verlauf 3Monate").Range("b10000").End(xlUp).Offset(1, 0) = "1"
ElseIf CheckBox1 = True And CheckBox2 = False Then
Worksheets("Verlauf 1.Jahr").Range("C10000").End(xlUp).Offset(1, 0) = Range("C3") & (" / ") & Range("A5") & (": ") & Cells(Target.Row, 1)
Worksheets("Verlauf 1.Jahr").Range("a10000").End(xlUp).Offset(1, 0) = Cells(Target.Row, 2)
Worksheets("Verlauf 1.Jahr").Range("b10000").End(xlUp).Offset(1, 0) = "1"
End If
End If
End If
Case 3
If IsDate(Target.Text) Then
If Year(Target) >= 2013 Then
If CheckBox1 = False And CheckBox2 = False Then
Worksheets("Verlauf 3Monate").Range("C10000").End(xlUp).Offset(1, 0) = Range("C3") & (" / ") & Range("A5") & (": ") & Cells(Target.Row, 1)
Worksheets("Verlauf 3Monate").Range("a10000").End(xlUp).Offset(1, 0) = Cells(Target.Row, 2)
Worksheets("Verlauf 3Monate").Range("b10000").End(xlUp).Offset(1, 0) = "1"
ElseIf CheckBox1 = True And CheckBox2 = False Then
Worksheets("Verlauf 1.Jahr").Range("C10000").End(xlUp).Offset(1, 0) = Range("C3") & (" / ") & Range("A5") & (": ") & Cells(Target.Row, 1)
Worksheets("Verlauf 1.Jahr").Range("a10000").End(xlUp).Offset(1, 0) = Cells(Target.Row, 3)
Worksheets("Verlauf 1.Jahr").Range("b10000").End(xlUp).Offset(1, 0) = "1"
End If
End If
End If
Case 4
If IsDate(Target.Text) Then
If Year(Target) >= 2013 Then
If CheckBox1 = False And CheckBox2 = False Then
Worksheets("Verlauf 3Monate").Range("C10000").End(xlUp).Offset(1, 0) = Range("C3") & (" / ") & Range("A5") & (": ") & Cells(Target.Row, 1)
Worksheets("Verlauf 3Monate").Range("a10000").End(xlUp).Offset(1, 0) = Cells(Target.Row, 4)
Worksheets("Verlauf 3Monate").Range("b10000").End(xlUp).Offset(1, 0) = "1"
ElseIf CheckBox1 = True And CheckBox2 = False Then
Worksheets("Verlauf 1.Jahr").Range("C10000").End(xlUp).Offset(1, 0) = Range("C3") & (" / ") & Range("A5") & (": ") & Cells(Target.Row, 1)
Worksheets("Verlauf 1.Jahr").Range("a10000").End(xlUp).Offset(1, 0) = Cells(Target.Row, 4)
Worksheets("Verlauf 1.Jahr").Range("b10000").End(xlUp).Offset(1, 0) = "1"
End If
End If
End If
End Select
End If
End Sub
Sub Worksheet_Change(ByVal Target As Range)
If Target.Row > 5 Then
Select Case Target.Column
Case 2, 3, 4
If IsDate(Target.Text) Then
If Year(Target) >= 2013 Then
If CheckBox1 = False And CheckBox2 = False Then
Worksheets("Verlauf 3Monate").Range("C10000").End(xlUp).Offset(1, 0) = Range("C3") & (" / ") & Range("A5") & (": ") & Cells(Target.Row, 1) & (" kann ") & Range("B3") & (" ") & Range("A3")
Worksheets("Verlauf 3Monate").Range("a10000").End(xlUp).Offset(1, 0) = Cells(Target.Row, Target.colum)
Worksheets("Verlauf 3Monate").Range("b10000").End(xlUp).Offset(1, 0) = "1"
ElseIf CheckBox1 = True And CheckBox2 = False Then
Worksheets("Verlauf 1.Jahr").Range("C10000").End(xlUp).Offset(1, 0) = Range("C3") & (" / ") & Range("A5") & (": ") & Cells(Target.Row, 1)
Worksheets("Verlauf 1.Jahr").Range("a10000").End(xlUp).Offset(1, 0) = Cells(Target.Row, Target.colum)
Worksheets("Verlauf 1.Jahr").Range("b10000").End(xlUp).Offset(1, 0) = "1"
End If
End If
End If
End Select
End If
End Sub
05.02.2015, 17:19 (Dieser Beitrag wurde zuletzt bearbeitet: 05.02.2015, 17:24 von Kuwer.)
Hallo,
Da war ja 5 mal dasselbe drin.
Teste mal das:
Code:
Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("B6:D9")) Is Nothing Then
If Target >= 2013 And CheckBox1 = False And CheckBox2 = False Then
With Worksheets("Verlauf 3Monate").Cells(Rows.Count, 1).End(xlUp)
.Offset(1, 0).Value = Target.Value
.Offset(1, 1).Value = 1
.Offset(1, 2).Value = Range("C3").Value & (" / ") & _
Range("A5").Value & (": ") & _
Range("A6").Value & (" kann ") & _
Range("B3").Value & (" ") & _
Range("A3").Value
End With
End If
End If
If Not Application.Intersect(Target, Range("B12:D15")) Is Nothing Then
If Target >= 2013 And CheckBox1 = False And CheckBox2 = False Then
With Worksheets("Verlauf 3Monate").Cells(Rows.Count, 1).End(xlUp)
.Offset(1, 0).Value = Target.Value
.Offset(1, 1).Value = 1
.Offset(1, 2).Value = Range("C3").Value & (" / ") & _
Range("A11").Value & (": ") & _
Range("A12").Value & (" kann ") & _
Range("B3").Value & (" ") & _
Range("A3").Value
End With
End If
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.
Sub Worksheet_Change(ByVal Target As Range)
Dim wks As Worksheet
Dim rng As Range
Dim loletzte As Long
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Union(Range("B6:D9"), Range("B12:D15"))) Is Nothing Then Exit Sub
If Not IsDate(Target.Text) Or Year(Target) < 2013 Then Exit Sub
If Not checkbox1 And checkbox2 Then Exit Sub
If checkbox1 Then
If checkbox2 Then
Set wks = Worksheets("Verlauf 2. Jahr")
Else
Set wks = Worksheets("Verlauf 1. Jahr")
End If
Else
Set wks = Worksheets("Verlauf 3Monate")
End If
With wks
loletzte = .Cells(Rows.Count, 1).End(xlUp).Row + 1
If Target.Row < 10 Then
.Cells(loletzte, 3) = Range("C3") & " / " & Range("A5") & ":" & Cells(Target.Row, 1)
If Not checkbox1 Then .Cells(loletzte, 3) = .Cells(loletzte, 3) & " kann " & B3 & " " & A3
Else
.Cells(loletzte, 3) = Range("C11") & " / " & Range("A11") & ":" & Cells(Target.Row, 1)
If Target.Row = 12 Then .Cells(loletzte, 3) = .Cells(loletzte, 3) & " kann " & B3 & " " & A3
End If
.Cells(loletzte, 2) = 1
.Cells(loletzte, 1) = Target
End With
End Sub
Gruß
Edgar
Meine Antworten sind freiwillig und ohne Gewähr!
Über Rückmeldungen würde ich mich freuen.