Hallo,

so in etwa sieht meine Tabelle aus. Es gibt natürlich noch ein paar mehr Spalten, aber der Übersicht halber nur ein paar. Die aller meisten dieser Spalten werden mit JA oder NEIN beantwortet, weshalb ich überwiegend Comboboxen benutzt habe oder Checkboxen. Bei den Comboboxen habe ich zur Auswahl auch JA und NEIN ausgewählt, in der Excel Datei werden jedoch immer 0 (Nein) und 1 (Ja) ausgegeben.

Ich habe leider keine Funktion gefunden um die Excel-Datei als solches hochzuladen.

Bei den Fallnummern sind etwa 600 vorgegeben und diesen Fallnummern muss ich die obenstehenden Daten eingeben, was mit einer Userform mit Check- und Comboboxen deutlich schneller geht. Ich hoffe das Bild zur Userform wird angezeigt, ansonsten ist hier der Link dazu.

Außerdem ist unten anstehend noch der Quellcode - ich weiß es wirkt vermutlich lächerlich, aber leider reichen meiner Fähigkeiten noch nicht für mehr.

Vielen Dank für eure Antworten ! :)

Private Sub Cancel_Button_Click()

'Eingabefenster schließen
Unload Formular_Pat

End Sub

Private Sub CB_Geschlecht_Change()

End Sub

Private Sub Frame3_Click()

End Sub

Private Sub Hilfe_Diagnose_CB_Click()
Hilfe_Diagnose.Show
End Sub

Private Sub Hilfe_Koro_CB_Click()
Hilfe_Koro.Show

End Sub

Private Sub Ok_Button_Click()

'Eingabe der Schaltflächen werden in die Arbeitsmappe übertragen

Dim last As Integer '.. "last" wird als letzte Zeile definiert
last = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1

'..........Fallnummer, Gesschlecht und EKG und ECHO, Koro CT

'Patienten Fallnummer
Cells(last, 1).Value = TB_Fallnummer

'Geschlecht
'Cells(last, 2).Value = CB_Geschlecht
If CB_Geschlecht = "Weiblich" Then Cells(last, 2).Value = "W"
If CB_Geschlecht = "Männlich" Then Cells(last, 2).Value = "M"

'Stressecho
Cells(last, 8).Value = CStr(CB_Stressecho)

'WBS (Wandbewegungsstörung)
If CB_WBS = "Ja" Then Cells(last, 9).Value = "1"
If CB_WBS = "Nein" Then Cells(last, 9).Value = "0"

'Beschwerden
'Cells(last, 10).Value = CStr(CB_Beschwerden)
If CB_Beschwerden = "Ja" Then Cells(last, 10).Value = "1"
If CB_Beschwerden = "Nein" Then Cells(last, 10).Value = "0"

'EKG
'Cells(last, 11).Value = CStr(CB_EKG)
If CB_EKG = "Ja" Then Cells(last, 11).Value = "1"
If CB_EKG = "Nein" Then Cells(last, 11).Value = "0"

'Rhythmusstörung
'Cells(last, 12).Value = CStr(CB_Rhythmus)
If CB_Rhythmus = "Ja" Then Cells(last, 12).Value = "1"
If CB_Rhythmus = "Nein" Then Cells(last, 12).Value = "0"

'KHK
Cells(last, 15).Value = CStr(CB_KHK)

'CAD
Cells(last, 14).Value = CStr(CB_CAD)


'............Checkboxen für Kardiovaskuläre Risikofaktoren

'Hypertonus
If CheckBox_Hypertonus = True Then Cells(last, 17).Value = "1"
If CheckBox_Hypertonus = False Then Cells(last, 17).Value = "0"

'Diabetes mellitus
If CheckBox_Diabetes = True Then Cells(last, 18).Value = "1"
If CheckBox_Diabetes = False Then Cells(last, 18).Value = "0"

'Hyperlipoproteinämie
If CheckBox_Lipoprotein = True Then Cells(last, 19).Value = "1"
If CheckBox_Lipoprotein = False Then Cells(last, 19).Value = "0"

'Nikotinabusus
If CheckBox_Nikotin = True Then Cells(last, 20).Value = "1"
If CheckBox_Nikotin = False Then Cells(last, 20).Value = "0"

'Ex-Nikotinabusus
If CheckBox_Ex = True Then Cells(last, 21).Value = "1"
If CheckBox_Ex = False Then Cells(last, 21).Value = "0"

'Adipositas
If CheckBox_Adipositas = True Then Cells(last, 22).Value = "1"
If CheckBox_Adipositas = False Then Cells(last, 22).Value = "0"

'Positive Familien-Anamnese
If CheckBox_FamAnam = True Then Cells(last, 23).Value = "1"
If CheckBox_FamAnam = False Then Cells(last, 23).Value = "0"

'.........Comboboxen Diagnose

'CCS
Cells(last, 24).Value = CStr(CB_CCS)

'NYHA
'Cells(last, 25).Value = CStr(CB_NYHA)
If CB_Rhythmus = "I" Then Cells(last, 25).Value = "1"
If CB_Rhythmus = "II" Then Cells(last, 25).Value = "2"
If CB_Rhythmus = "III" Then Cells(last, 25).Value = "3"
If CB_Rhythmus = "IV" Then Cells(last, 25).Value = "4"

'Bypass
'Cells(last, 26).Value = CStr(CB_Bypass)
If CB_Bypass = "Ja" Then Cells(last, 12).Value = "1"
If CB_Bypass = "Nein" Then Cells(last, 12).Value = "0"

'.............Bemerkungen

Cells(last, 27).Value = TB_Bemerkung


Unload meinFormular 'damit sich das Fenster schließt, wenn die Daten übernimmt

End Sub

Private Sub TB_Fallnummer_Enter()
'Farbe ändern beim reinschreiben
TB_Fallnummer.BackColor = vbGreen
End Sub

Private Sub TB_Fallnummer_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'Farbe ändern, wenn man nicht mehr in dem Feld ist
TB_Fallnummer.BackColor = vbWhite
End Sub

Private Sub CB_Geschlecht_Enter()
'Farbe ändern beim reinschreiben
CB_Geschlecht.BackColor = vbGreen
End Sub

Private Sub CB_Geschlecht_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'Farbe ändern, wenn man nicht mehr in dem Feld ist
CB_Geschlecht.BackColor = vbWhite
End Sub

Private Sub CB_Stressecho_Enter()
'Farbe ändern beim reinschreiben
CB_Stressecho.BackColor = vbGreen
End Sub

Private Sub CB_Stressecho_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'Farbe ändern, wenn man nicht mehr in dem Feld ist
CB_Stressecho.BackColor = vbWhite
End Sub

Private Sub CB_Beschwerden_Enter()
'Farbe ändern beim reinschreiben
CB_Beschwerden.BackColor = vbGreen
End Sub

Private Sub CB_Beschwerden_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'Farbe ändern, wenn man nicht mehr in dem Feld ist
CB_Beschwerden.BackColor = vbWhite
End Sub

Private Sub CB_EKG_Enter()
'Farbe ändern beim reinschreiben
CB_EKG.BackColor = vbGreen
End Sub

Private Sub CB_EKG_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'Farbe ändern, wenn man nicht mehr in dem Feld ist
CB_EKG.BackColor = vbWhite
End Sub

Private Sub CB_Rhythmus_Enter()
'Farbe ändern beim reinschreiben
CB_Rhythmus.BackColor = vbGreen
End Sub

Private Sub CB_Rhythmus_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'Farbe ändern, wenn man nicht mehr in dem Feld ist
CB_Rhythmus.BackColor = vbWhite
End Sub

Private Sub CB_WBS_Enter()
'Farbe ändern beim reinschreiben
CB_WBS.BackColor = vbGreen
End Sub

Private Sub CB_WBS_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'Farbe ändern, wenn man nicht mehr in dem Feld ist
CB_WBS.BackColor = vbWhite
End Sub

Private Sub CB_KHK_Enter()
'Farbe ändern beim reinschreiben
CB_KHK.BackColor = vbGreen
End Sub

Private Sub CB_KHK_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'Farbe ändern, wenn man nicht mehr in dem Feld ist
CB_KHK.BackColor = vbWhite
End Sub

Private Sub CB_CAD_Enter()
'Farbe ändern beim reinschreiben
CB_CAD.BackColor = vbGreen
End Sub

Private Sub CB_CAD_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'Farbe ändern, wenn man nicht mehr in dem Feld ist
CB_CAD.BackColor = vbWhite
End Sub

Private Sub CB_CCS_Enter()
'Farbe ändern beim reinschreiben
CB_CCS.BackColor = vbGreen
End Sub

Private Sub CB_CCS_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'Farbe ändern, wenn man nicht mehr in dem Feld ist
CB_CCS.BackColor = vbWhite
End Sub

Private Sub CB_NYHA_Enter()
'Farbe ändern beim reinschreiben
CB_NYHA.BackColor = vbGreen
End Sub

Private Sub CB_NYHA_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'Farbe ändern, wenn man nicht mehr in dem Feld ist
CB_NYHA.BackColor = vbWhite
End Sub

Private Sub CB_Bypass_Enter()
'Farbe ändern beim reinschreiben
CB_Bypass.BackColor = vbGreen
End Sub

Private Sub CB_Bypass_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'Farbe ändern, wenn man nicht mehr in dem Feld ist
CB_Bypass.BackColor = vbWhite
End Sub

Private Sub UserForm_Initialize()

With CB_Geschlecht
.AddItem "Weiblich"
.AddItem "Männlich"
'.ListIndex = 0 'Es steht immer zuerst 1
End With

With CB_Stressecho
.AddItem "1"
.AddItem "2"
.AddItem "X"
'.ListIndex = 0 'Es steht immer zuerst 1
End With

With CB_Beschwerden
.AddItem "Ja"
.AddItem "Nein"
'.ListIndex = 0 'Es steht immer zuerst 1
End With

With CB_WBS
.AddItem "Ja"
.AddItem "Nein"
'.ListIndex = 0 'Es steht immer zuerst 1
End With

With CB_EKG
.AddItem "Ja"
.AddItem "Nein"
'.ListIndex = 0 'Es steht immer zuerst 1
End With

With CB_Rhythmus
.AddItem "Ja"
.AddItem "Nein"
'.ListIndex = 0 'Es steht immer zuerst 1
End With

With CB_KHK
.AddItem "Ja"
.AddItem "Nein"
'.ListIndex = 0 'Es steht immer zuerst 1
End With

'Dim i As Integer ' "i" als Integer klassifizieren

With CB_CAD
For i = 0 To 99
.AddItem CStr(i)
Next
End With

With CB_CCS
.AddItem "0"
.AddItem "1"
.AddItem "2"
.AddItem "3"
.AddItem "4"
'.ListIndex = 0 'Es steht immer zuerst 1
End With

With CB_NYHA
.AddItem "I"
.AddItem "II"
.AddItem "III"
.AddItem "IV"
'.ListIndex = 0 'Es steht immer zuerst 1
End With

With CB_Bypass
.AddItem "Ja"
.AddItem "Nein"
'.ListIndex = 0 'Es steht immer zuerst 1
End With

End Sub