Code kürzen bzw abändern
26.03.2019 10:29:31
Pierre
ich habe keine Problem in dem Sinne, sondern hätte gerne Unterstützung dabei, meine Codes zu kürzen, sofern das überhaupt hierbei machbar ist.
Alternativ kann natürlich auch ein völlig anderes Code-Konstrukt vorgeschlagen werden.
Mir geht es einfach um die unheimliche Länge, da kriegt man schon fast Angst...
Code 3 stammt aus diesem Forum, 1 und 2 habe ich mir durch verschiedene Seiten selbst zusammen gebastelt (so sieht es vermutlich auch für die Profis aus ;) )
1. Teil (hier habe ich den gesamten Block für jedes weitere Jahr erneut)
Kurz erklärt: Ich wähle aus ComboBox "2019" aus, das schreibt er mir in Zelle B1, wenn in B1 " _ 2019" steht, löscht er die Einträge aus den u. g. Bereichen und schreibt zusätzlich noch "2019" in alle weiteren Blätter immer in Zelle E56. Das Gleiche natürlich bei allen anderen Jahren auch. Geleert werden sollen die Bereiche bei jeder Änderung der ComboBox.
Private Sub ComboBox1_Change()
Select Case Me.ComboBox1.Value
Case "2019"
Range("B1") = "2019"
If Range("B1").Value = "2019" Then Range("D4:NE6").Value = ""
If Range("B1").Value = "2019" Then Range("D8:NE10").Value = ""
If Range("B1").Value = "2019" Then Range("D12:NE14").Value = ""
If Range("B1").Value = "2019" Then Range("D16:NE18").Value = ""
If Range("B1").Value = "2019" Then Range("D20:NE22").Value = ""
If Range("B1").Value = "2019" Then Range("D24:NE26").Value = ""
If Range("B1").Value = "2019" Then Range("D28:NE30").Value = ""
If Range("B1").Value = "2019" Then Range("D32:NE34").Value = ""
If Range("B1").Value = "2019" Then Range("D36:NE38").Value = ""
If Range("B1").Value = "2019" Then Worksheets("Januar").Range("E56").Value = "2019"
If Range("B1").Value = "2019" Then Worksheets("Februar").Range("E56").Value = "2019"
If Range("B1").Value = "2019" Then Worksheets("März").Range("E56").Value = "2019"
If Range("B1").Value = "2019" Then Worksheets("April").Range("E56").Value = "2019"
If Range("B1").Value = "2019" Then Worksheets("Mai").Range("E56").Value = "2019"
If Range("B1").Value = "2019" Then Worksheets("Juni").Range("E56").Value = "2019"
If Range("B1").Value = "2019" Then Worksheets("Juli").Range("E56").Value = "2019"
If Range("B1").Value = "2019" Then Worksheets("August").Range("E56").Value = "2019"
If Range("B1").Value = "2019" Then Worksheets("September").Range("E56").Value="2019"
If Range("B1").Value = "2019" Then Worksheets("Oktober").Range("E56").Value = "2019"
If Range("B1").Value = "2019" Then Worksheets("November").Range("E56").Value= "2019"
If Range("B1").Value = "2019" Then Worksheets("Dezember").Range("E56").Value ="2019"
Case "2020"
2. Teil: Hier spring er mir immer zu der definierten Zelle, so weit so gut. Aber nächstes Jahr ist Schaltjahr, also verschiebt sich die ganze Tabelle, sodass er mir nicht mehr zum 1. eines Monats springt, sondern zum letzten des Vormonats.
Wäre nicht ganz so tragisch, wenn sich hier keine bessere Lösung finden lässt.
Schöner wäre es halt, wenn er das Datum sucht und zu dieser Zelle springt.
Die Zelle soll immer ganz links (ersten 3 Spalten fixiert) angezeigt werden.
Private Sub ComboBox2_Change()
Select Case Me.ComboBox2.Value
Case "Jan"
Range("B2") = "Jan"
ActiveWindow.ScrollColumn = 4
3. Teil: Hier eigentlich nur die Frage, ob man den Code auch in die weiteren Blätter einfügen kann?
Wenn ich den einfach nur kopiere, geht es leider nicht. Müsste also irgendwas angepasst werden, vermute ich, aber was?
Dieser Code verbindet die Zelle, in der ein bestimmtes Wort eingetragen wird mit der _
darunterliegenden Zelle.
z = Target.Row
s = Target.Column
mo = z Mod 4
If mo > 1 Then Exit Sub
If s 369 Then Exit Sub
If z 28 Then Exit Sub
'If mo = 0 Then mo = 5
mo = 2 - mo * 2 - 1
Application.EnableEvents = False
If Target.Text = "Urlaub2" Or Target.Text = "Krank" Or Target.Text = "Urlaub1" Then
Cells(z + mo, s) = Target.Text
Application.DisplayAlerts = False
Range(Cells(z + mo, s), Cells(z, s)).MergeCells = True
Application.DisplayAlerts = True
Else
If Target.Text = "" Then
Cells(z + mo, s) = ""
Range(Cells(z + mo, s), Cells(z, s)).MergeCells = False
End If
End If
Application.EnableEvents = True
Exit Sub
'*** Fehlerbehandlung
Fehler:
Application.EnableEvents = True
If Err.Number 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear
Ich hoffe, ihr könnt mir folgen und auch helfen, die elendig langen Codes zu kürzen.
Ich weiß nicht, ob dafür eine Beispielmappe von Vorteil wäre, wenn diese benötigt werden sollte, dann stelle ich gerne eine zur Verfügung.
Herzlichen Dank im Voraus!
Gruß Pierre