Code vereinfachen
20.02.2018 19:58:52
Daniel
Ich bin nun endlich am Ende eines umfangreichen Excel-Projekts angelangt und mache mich nun daran, den Code zu vereinfachen. Meine Erfahrung hält sich noch in Grenzen und deshalb wollte ich Euch um hilfreiche Erfahrungstipps bitten. Als Beispiel habe ich hier eine Codesequenz, in der z.T. die gleiche Eigenschaft (Farbe RGB) mehreren Labels (lbl) in einer Userform zugewiesen wird. Wie lässt sich dies einfacher machen? Habt ihr generelle konkrete Ideen, wie man nachfolgende Codesequenz vereinfachen bzw. schneller machen könnten? Fallen euch grundlegende "Bremser" auf? (Vereinfacht gesagt hat dieser Code zum Ziel, eine Userform mit den bereits eingespeisten Daten erneut zu befüllen, nachdem die Datei geschlossen wurde):
Option Explicit
Private Sub UserForm_Initialize()
'Aktiviert die passenden Hintergrundfarben
frmUHR.BackColor = RGB(130, 175, 215)
lblZHUHR.BackColor = RGB(130, 175, 215)
lblCopyright.BackColor = RGB(130, 175, 215)
frmET1.BackColor = RGB(253, 233, 217)
lblET1Children.BackColor = RGB(253, 233, 217)
lblET1Name.BackColor = RGB(253, 233, 217)
lblET1Child1.BackColor = RGB(253, 233, 217)
lblET1Child2.BackColor = RGB(253, 233, 217)
lblET1Child3.BackColor = RGB(253, 233, 217)
lblET1Child4.BackColor = RGB(253, 233, 217)
frmET2.BackColor = RGB(218, 238, 243)
lblET2Children.BackColor = RGB(218, 238, 243)
lblET2Name.BackColor = RGB(218, 238, 243)
lblET2Child1.BackColor = RGB(218, 238, 243)
lblET2Child2.BackColor = RGB(218, 238, 243)
lblET2Child3.BackColor = RGB(218, 238, 243)
lblET2Child4.BackColor = RGB(218, 238, 243)
frmET1NewPartner.BackColor = RGB(253, 233, 217)
lblET1NewPartnerData.BackColor = RGB(253, 233, 217)
FrmET2NewPartner.BackColor = RGB(218, 238, 243)
txtET2NewPartnerName.BackColor = RGB(218, 238, 243)
txtET2NewPartnerBirth.BackColor = RGB(218, 238, 243)
chbET2NewPartnerCare.BackColor = RGB(218, 238, 243)
'Aktualisiert Multipage 0 vorhandenen Daten aus Sheets("RawData")
txtCase = Sheets("RawData").Range("E1")
txtDate = Sheets("RawData").Range("F1")
txtET1Name = Sheets("RawData").Range("E2")
txtET1Birth = Sheets("RawData").Range("E3")
cboET1Children = Sheets("RawData").Range("E4")
txtET1Child1Name = Sheets("RawData").Range("E5")
txtET1Child1Birth = Sheets("RawData").Range("E6")
txtET1Child2Name = Sheets("RawData").Range("E7")
txtET1Child2Birth = Sheets("RawData").Range("E8")
txtET1Child3Name = Sheets("RawData").Range("E9")
txtET1Child3Birth = Sheets("RawData").Range("E10")
txtET1Child4Name = Sheets("RawData").Range("E11")
txtET1Child4Birth = Sheets("RawData").Range("E12")
txtET2Name = Sheets("RawData").Range("F2")
txtET2Birth = Sheets("RawData").Range("F3")
cboET2Children = Sheets("RawData").Range("F4")
txtET2Child1Name = Sheets("RawData").Range("F5")
txtET2Child1Birth = Sheets("RawData").Range("F6")
txtET2Child2Name = Sheets("RawData").Range("F7")
txtET2Child2Birth = Sheets("RawData").Range("F8")
txtET2Child3Name = Sheets("RawData").Range("F9")
txtET2Child3Birth = Sheets("RawData").Range("F10")
txtET2Child4Name = Sheets("RawData").Range("F11")
txtET2Child4Birth = Sheets("RawData").Range("F12")
'Aktualisiert Multipage 1 mit vorhandenen Daten aus Sheets("RawData")
cboPhases = Sheets("RawData").Range("I1")
txtPhase1StartDate = Sheets("RawData").Range("I2")
txtPhase1EndDate = Sheets("RawData").Range("J2")
txtPhase2StartDate = Sheets("RawData").Range("I3")
txtPhase2EndDate = Sheets("RawData").Range("J3")
txtPhase3StartDate = Sheets("RawData").Range("I4")
txtPhase3EndDate = Sheets("RawData").Range("J4")
txtPhase4StartDate = Sheets("RawData").Range("I5")
txtPhase4EndDate = Sheets("RawData").Range("J5")
'Aktualistiert Multipage 2 mit den zuvor eingegebenen Daten
cboET1NewPartner = Sheets("RawData").Range("L1")
txtET1NewPartnerName = Sheets("RawData").Range("L2")
txtET1NewPartnerBirth = Sheets("RawData").Range("L3")
chbET1NewPartnerCare = Sheets("RawData").Range("L4")
cboET2NewPartner = Sheets("RawData").Range("M1")
txtET2NewPartnerName = Sheets("RawData").Range("M2")
txtET2NewPartnerBirth = Sheets("RawData").Range("M3")
chbET2NewPartnerCare = Sheets("RawData").Range("M4")
'Setzt cboChildren auf 0 wenn kein Anfangswert in cboChildren oder in RawData vorhanden ist
If cboET1Children = "" Or Sheets("RawData").Range("E4") = "" Then
cboET1Children = 0
End If
If cboET2Children = "" Or Sheets("RawData").Range("F4") = "" Then
cboET2Children = 0
End If
'Setzt cbo New Partner auf 0 wenn kein Anfangswert in RawSource vorhanden ist
If cboET1NewPartner = "Nein" Or cboET1NewPartner = "" Then
lblET1NewPartner.Visible = False
txtET1NewPartnerName.Visible = False
txtET1NewPartnerBirth.Visible = False
chbET1NewPartnerCare.Visible = False
Else: lblET1NewPartner.Visible = True
lblET1NewPartner.Visible = True
txtET1NewPartnerName.Visible = True
txtET1NewPartnerName.Visible = True
chbET1NewPartnerCare.Visible = True
End If
If cboET2NewPartner = "Nein" Or cboET2NewPartner = "" Then
lblET2NewPartner.Visible = False
txtET2NewPartnerName.Visible = False
txtET2NewPartnerBirth.Visible = False
chbET2NewPartnerCare.Visible = False
Else: lblET2NewPartner.Visible = True
lblET2NewPartner.Visible = True
txtET2NewPartnerName.Visible = True
txtET2NewPartnerBirth.Visible = True
chbET2NewPartnerCare.Visible = True
End If
frmUHR.MultiPage1.Value = 0
End Sub
Beste Grüsse - Daniel
Anzeige