Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1392to1396
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Textbox austauschen gegen Combobox

Textbox austauschen gegen Combobox
17.11.2014 11:02:38
Langmantl
Ich möchte in der Userform der beigelegten Datei die Textbox4 umwandeln in eine Combobox, diese muss aber alle Funktionen der Textbox erfüllen, d.H. Wenn in der Auswahlliste ein Namen angeklickt wird, trägt er die vorhandenen Daten alle in die entsprechenden Textboxen ein. Die Combobox soll die Werte der Tabelle5 Spalte A3 bis a8 zur Auswahl haben. wichtig ist mir dabei, dass wenn der Datensatz angezeigt wird, bei dem bereits ein Gruppenleiter eingestellt ist, soll er den entsprechenden Gruppenleiter anzeigen.
Es geht darum, dass es bei einem Gruppenleiterwechsel keine Schreib und Eingabefehler geben kann, deshalb möchte ich das in mit einer Combobox anbieten.
In der Beigelegten Datei habe ich das Userform so geändert, dass dort sich bereits eine Combobox1 befindet. Die bisherige Textbox habe ich unter die Commandbutten verschoben. Diese möchte ich nach Umsetzung löschen.
Hier die Datei:
https://www.herber.de/bbs/user/93816.xlsm
Option Explicit
'Neuer Eintrag Schaltfläche Ereignisroutine

Private Sub CommandButton1_Click()
Dim lZeile As Long
lZeile = 3
'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
Do While Trim(CStr(Tabelle3.Cells(lZeile, 1).Value))  ""
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
Tabelle3.Cells(lZeile, 1) = CStr("Neuer Eintrag Zeile " & lZeile)
ListBox1.AddItem CStr("Neuer Eintrag Zeile " & lZeile)
ListBox1.ListIndex = ListBox1.ListCount - 1
End Sub

'Löschen Schaltfläche Ereignisroutine

Private Sub CommandButton2_Click()
Dim lZeile As Long
'Wenn kein Datensatz in der ListBox markiert wurde, wird die Routine beendet
If ListBox1.ListIndex = -1 Then Exit Sub
'Zum Löschen benötigen wir die Zeilennummer des ausgewählten Datensatzes
lZeile = 3 'Start in Zeile 5, Zeile 1 sind ja die Überschriften
'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
Do While Trim(CStr(Tabelle3.Cells(lZeile, 1).Value))  ""
'Datensatz ID Spalte mit selektiertem Eintrag der ListBox vergleichen
If ListBox1.Text = Trim(CStr(Tabelle3.Cells(lZeile, 1).Value)) Then
'Eintrag gefunden, die ganze Zeile wird nun gelöscht
Tabelle3.Rows(CStr(lZeile & ":" & lZeile)).Delete
Range("A3:J100").Select
ActiveWorkbook.Worksheets("MitarbeiterDB").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("MitarbeiterDB").Sort.SortFields.Add Key:=Range( _
"A3"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("MitarbeiterDB").Sort
.SetRange Range("A3:J100")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Die ListBox muss nun neu geladen werden!
Call UserForm_Initialize
If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
Exit Do 'Vorzeitiges Ende, da der Datensatz schon gefunden ist
End If
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
End Sub

'Speichern Schaltfläche Ereignisroutine

Private Sub CommandButton3_Click()
Dim lZeile As Long
'Wenn kein Datensatz in der ListBox markiert wurde, wird die Routine beendet
If ListBox1.ListIndex = -1 Then Exit Sub
'Wir müssen prüfen, ob die ID Spalte auch gefüllt ist!!
If Trim(CStr(TextBox1.Text)) = "" Then
'Meldung ausgeben
MsgBox "Sie müssen mindestens einen Namen eingeben!", vbCritical + vbOKOnly, "FEHLER!" _
'Abbrechen der Speicherroutine
Exit Sub
End If
'Ausbauoption: Prüfen, ob die ID in Tabelle1 Spalte 1 schon vorhanden ist!
'Zum Speichern benötigen wir die Zeilennummer des ausgewählten Datensatzes
lZeile = 3 'Start in Zeile 2, Zeile 1 sind ja die Überschriften
'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
Do While Trim(CStr(Tabelle3.Cells(lZeile, 1).Value))  ""
'Datensatz ID Spalte mit selektiertem Eintrag der ListBox vergleichen
If ListBox1.Text = Trim(CStr(Tabelle3.Cells(lZeile, 1).Value)) Then
'Eintrag gefunden, TextBoxen in die Zellen schreiben
Tabelle3.Cells(lZeile, 1).Value = Trim(CStr(TextBox1.Text))
Tabelle3.Cells(lZeile, 2).Value = TextBox4.Text
Tabelle3.Cells(lZeile, 3).Value = TextBox3.Text
If Me.CheckBox1 = True Then
Tabelle3.Cells(lZeile, 4).Value = "Ja"
Else: Tabelle3.Cells(lZeile, 4).Value = ""
End If
If Me.CheckBox2 = True Then
Tabelle3.Cells(lZeile, 5).Value = "Ja"
Else: Tabelle3.Cells(lZeile, 5).Value = ""
End If
If Me.CheckBox3 = True Then
Tabelle3.Cells(lZeile, 6).Value = "Ja"
Else: Tabelle3.Cells(lZeile, 6).Value = ""
End If
If Me.CheckBox4 = True Then
Tabelle3.Cells(lZeile, 7).Value = "Ja"
Else: Tabelle3.Cells(lZeile, 7).Value = ""
End If
If Me.CheckBox5 = True Then
Tabelle3.Cells(lZeile, 8).Value = "Ja"
Else: Tabelle3.Cells(lZeile, 8).Value = ""
End If
If Me.CheckBox6 = True Then
Tabelle3.Cells(lZeile, 9).Value = "Ja"
Else: Tabelle3.Cells(lZeile, 9).Value = ""
End If
Range("A3:J100").Select
ActiveWorkbook.Worksheets("MitarbeiterDB").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("MitarbeiterDB").Sort.SortFields.Add Key:=Range( _
"A3"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("MitarbeiterDB").Sort
.SetRange Range("A3:J100")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Die ListBox muss nun neu geladen werden
'allerdings nur, wenn sich der Name (ID) geändert hat
If ListBox1.Text  Trim(CStr(TextBox1.Text)) Then
Call UserForm_Initialize
If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
End If
Exit Do 'Vorzeitiges Ende, da der Datensatz schon gefunden ist
End If
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
End Sub

'Beenden Schaltfläche Ereignisroutine

Private Sub CommandButton4_Click()
Unload Me
End Sub

'Klick auf die ListBox Ereignisroutine

Private Sub ListBox1_Click()
Dim lZeile As Long
Dim i As Variant
'Wenn der Benutzer einen Namen anklickt, suchen wir
'diesen in der Tabelle1 heraus und tragen die Daten
'in die TextBoxen ein.
'Wir löschen standardmäßig alle bisherigen TextBoxen-Inhalte
TextBox1 = ""
TextBox3 = ""
TextBox4 = ""
'Nur wenn ein Eintrag selektiert/markiert ist
If ListBox1.ListIndex >= 0 Then
lZeile = 3 'Start in Zeile 2, Zeile 1 sind ja die Überschriften
'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
Do While Trim(CStr(Tabelle3.Cells(lZeile, 1).Value))  ""
'Wenn wir den Namen aus der ListBox1 in der Tabelle1 Spalte 1
'gefunden haben, übertragen wir die anderen Spalteninhalte
'in die TextBoxen!
If ListBox1.Text = Trim(CStr(Tabelle3.Cells(lZeile, 1).Value)) Then
'TextBoxen füllen
TextBox1 = Trim(CStr(Tabelle3.Cells(lZeile, 1).Value))
TextBox4 = Tabelle3.Cells(lZeile, 2).Value
TextBox3 = Tabelle3.Cells(lZeile, 3).Value
If Tabelle3.Cells(lZeile, 4).Value = "Ja" Then
Me.CheckBox1 = Tabelle3.Cells(lZeile, 4).Value
Me.CheckBox1 = True
Else: Me.CheckBox1 = False
End If
If Tabelle3.Cells(lZeile, 5).Value = "Ja" Then
Me.CheckBox2 = Tabelle3.Cells(lZeile, 5).Value
Me.CheckBox2 = True
Else: Me.CheckBox2 = False
End If
If Tabelle3.Cells(lZeile, 6).Value = "Ja" Then
Me.CheckBox3 = Tabelle3.Cells(lZeile, 6).Value
Me.CheckBox3 = True
Else: Me.CheckBox3 = False
End If
If Tabelle3.Cells(lZeile, 7).Value = "Ja" Then
Me.CheckBox4 = Tabelle3.Cells(lZeile, 7).Value
Me.CheckBox4 = True
Else: Me.CheckBox4 = False
End If
If Tabelle3.Cells(lZeile, 8).Value = "Ja" Then
Me.CheckBox5 = Tabelle3.Cells(lZeile, 8).Value
Me.CheckBox5 = True
Else: Me.CheckBox5 = False
If Tabelle3.Cells(lZeile, 9).Value = "Ja" Then
Me.CheckBox6 = Tabelle3.Cells(lZeile, 9).Value
Me.CheckBox6 = True
Else: Me.CheckBox6 = False
End If
End If
Exit Do 'Vorzeitiges Ende, da der Datensatz schon gefunden ist
End If
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
End If
End Sub

Private Sub UserForm_Activate()
'Wenn die Eingabemaske angezeigt wird, markieren wir den ersten Namen
'jedoch nur, wenn auch Einträge in der Liste stehen
If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
End Sub

'Startroutine, wird ausgeführt bevor die Eingabemaske angezeigt wird

Private Sub UserForm_Initialize()
Dim lZeile As Long
'Alle TextBoxen leer machen
TextBox1 = ""
TextBox3 = ""
TextBox4 = ""
'In dieser Routine laden wir alle vorhandenen
'Einträge in die ListBox1
ListBox1.Clear 'Zuerst einmal die Liste leeren
lZeile = 3 'Start in Zeile 2, Zeile 1 sind ja die Überschriften
'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
Do While Trim(CStr(Tabelle3.Cells(lZeile, 1).Value))  ""
'Aktuelle Zeile in die ListBox eintragen
ListBox1.AddItem Trim(CStr(Tabelle3.Cells(lZeile, 1).Value))
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
End Sub

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Textbox austauschen gegen Combobox
17.11.2014 12:19:49
fcs
Hallo Benedikt,
nachfolgend die Makros des Userforms in denen Anpassungen erforderlich sind.
Zusätzlich musst du für die Combobox1 für die Eigenschaft RowSource eintragen: Gruppenleiter!A3:A8
Gruß
Franz
'Speichern Schaltfläche Ereignisroutine
Private Sub CommandButton3_Click()
Dim lZeile As Long
'Wenn kein Datensatz in der ListBox markiert wurde, wird die Routine beendet
If ListBox1.ListIndex = -1 Then Exit Sub
'Wir müssen prüfen, ob die ID Spalte auch gefüllt ist!!
If Trim(CStr(TextBox1.Text)) = "" Then
'Meldung ausgeben
MsgBox "Sie müssen mindestens einen Namen eingeben!", vbCritical + vbOKOnly, "FEHLER!" _
'Abbrechen der Speicherroutine
Exit Sub
End If
'Ausbauoption: Prüfen, ob die ID in Tabelle1 Spalte 1 schon vorhanden ist!
'Zum Speichern benötigen wir die Zeilennummer des ausgewählten Datensatzes
lZeile = 3 'Start in Zeile 2, Zeile 1 sind ja die Überschriften
'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
Do While Trim(CStr(Tabelle3.Cells(lZeile, 1).Value))  ""
'Datensatz ID Spalte mit selektiertem Eintrag der ListBox vergleichen
If ListBox1.Text = Trim(CStr(Tabelle3.Cells(lZeile, 1).Value)) Then
'Eintrag gefunden, TextBoxen in die Zellen schreiben
Tabelle3.Cells(lZeile, 1).Value = Trim(CStr(TextBox1.Text))
'Tabelle3.Cells(lZeile, 2).Value = TextBox4.Text
Tabelle3.Cells(lZeile, 2).Value = Me.ComboBox1.Value '### geändert ###
Tabelle3.Cells(lZeile, 3).Value = TextBox3.Text
If Me.CheckBox1 = True Then
Tabelle3.Cells(lZeile, 4).Value = "Ja"
Else: Tabelle3.Cells(lZeile, 4).Value = ""
End If
If Me.CheckBox2 = True Then
Tabelle3.Cells(lZeile, 5).Value = "Ja"
Else: Tabelle3.Cells(lZeile, 5).Value = ""
End If
If Me.CheckBox3 = True Then
Tabelle3.Cells(lZeile, 6).Value = "Ja"
Else: Tabelle3.Cells(lZeile, 6).Value = ""
End If
If Me.CheckBox4 = True Then
Tabelle3.Cells(lZeile, 7).Value = "Ja"
Else: Tabelle3.Cells(lZeile, 7).Value = ""
End If
If Me.CheckBox5 = True Then
Tabelle3.Cells(lZeile, 8).Value = "Ja"
Else: Tabelle3.Cells(lZeile, 8).Value = ""
End If
If Me.CheckBox6 = True Then
Tabelle3.Cells(lZeile, 9).Value = "Ja"
Else: Tabelle3.Cells(lZeile, 9).Value = ""
End If
Range("A3:J100").Select
ActiveWorkbook.Worksheets("MitarbeiterDB").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("MitarbeiterDB").Sort.SortFields.Add Key:=Range( _
"A3"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("MitarbeiterDB").Sort
.SetRange Range("A3:J100")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Die ListBox muss nun neu geladen werden
'allerdings nur, wenn sich der Name (ID) geändert hat
If ListBox1.Text  Trim(CStr(TextBox1.Text)) Then
Call UserForm_Initialize
If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
End If
Exit Do 'Vorzeitiges Ende, da der Datensatz schon gefunden ist
End If
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
End Sub
'Klick auf die ListBox Ereignisroutine
Private Sub ListBox1_Click()
Dim lZeile As Long
Dim i As Variant
'Wenn der Benutzer einen Namen anklickt, suchen wir
'diesen in der Tabelle1 heraus und tragen die Daten
'in die TextBoxen ein.
'Wir löschen standardmäßig alle bisherigen TextBoxen-Inhalte
TextBox1 = ""
TextBox3 = ""
'TextBox4 = ""
Me.ComboBox1.ListIndex = -1                             '### geändert ###
'Nur wenn ein Eintrag selektiert/markiert ist
If ListBox1.ListIndex >= 0 Then
With Me.ListBox1
Me.ComboBox1 = .List(.ListIndex, 1)
End With
lZeile = 3 'Start in Zeile 2, Zeile 1 sind ja die Überschriften
'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
Do While Trim(CStr(Tabelle3.Cells(lZeile, 1).Value))  ""
'Wenn wir den Namen aus der ListBox1 in der Tabelle1 Spalte 1
'gefunden haben, übertragen wir die anderen Spalteninhalte
'in die TextBoxen!
If ListBox1.Text = Trim(CStr(Tabelle3.Cells(lZeile, 1).Value)) Then
'TextBoxen füllen
TextBox1 = Trim(CStr(Tabelle3.Cells(lZeile, 1).Value))
'TextBox4 = Tabelle3.Cells(lZeile, 2).Value
Me.ComboBox1 = Tabelle3.Cells(lZeile, 2).Value    '### geändert ###
TextBox3 = Tabelle3.Cells(lZeile, 3).Value
If Tabelle3.Cells(lZeile, 4).Value = "Ja" Then
Me.CheckBox1 = Tabelle3.Cells(lZeile, 4).Value
Me.CheckBox1 = True
Else: Me.CheckBox1 = False
End If
If Tabelle3.Cells(lZeile, 5).Value = "Ja" Then
Me.CheckBox2 = Tabelle3.Cells(lZeile, 5).Value
Me.CheckBox2 = True
Else: Me.CheckBox2 = False
End If
If Tabelle3.Cells(lZeile, 6).Value = "Ja" Then
Me.CheckBox3 = Tabelle3.Cells(lZeile, 6).Value
Me.CheckBox3 = True
Else: Me.CheckBox3 = False
End If
If Tabelle3.Cells(lZeile, 7).Value = "Ja" Then
Me.CheckBox4 = Tabelle3.Cells(lZeile, 7).Value
Me.CheckBox4 = True
Else: Me.CheckBox4 = False
End If
If Tabelle3.Cells(lZeile, 8).Value = "Ja" Then
Me.CheckBox5 = Tabelle3.Cells(lZeile, 8).Value
Me.CheckBox5 = True
Else: Me.CheckBox5 = False
If Tabelle3.Cells(lZeile, 9).Value = "Ja" Then
Me.CheckBox6 = Tabelle3.Cells(lZeile, 9).Value
Me.CheckBox6 = True
Else: Me.CheckBox6 = False
End If
End If
Exit Do 'Vorzeitiges Ende, da der Datensatz schon gefunden ist
End If
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
End If
End Sub
'Startroutine, wird ausgeführt bevor die Eingabemaske angezeigt wird
Private Sub UserForm_Initialize()
Dim lZeile As Long
'Alle TextBoxen leer machen
TextBox1 = ""
TextBox3 = ""
'TextBox4 = ""
ComboBox1.ListIndex = -1                        '### geändert ###
'In dieser Routine laden wir alle vorhandenen
'Einträge in die ListBox1
ListBox1.Clear 'Zuerst einmal die Liste leeren
lZeile = 3 'Start in Zeile 2, Zeile 1 sind ja die Überschriften
'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
Do While Trim(CStr(Tabelle3.Cells(lZeile, 1).Value))  ""
'Aktuelle Zeile in die ListBox eintragen
ListBox1.AddItem Trim(CStr(Tabelle3.Cells(lZeile, 1).Value))
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
End Sub

Anzeige
AW: Textbox austauschen gegen Combobox
17.11.2014 13:00:51
Langmantl
Danke, funktioniert, habe aber jetzt das Problem, nachdem ich deinen Code eingegeben habe, und auf den Button löschen gehe zeigt er mir einen Debug Fehler an:
Option Explicit
Private Sub Worksheet_Calculate()
Dim rng As Range
Application.ScreenUpdating = False
With Tabelle2
.UsedRange.EntireRow.Hidden = False
Set rng = .Columns(34).SpecialCells(xlCellTypeFormulas, 1)
If Not rng Is Nothing Then
rng.EntireRow.Hidden = True
End If
End With
Application.ScreenUpdating = True
End Sub
folgende Zeile ist gelb hinterlegt:
Set rng = .Columns(34).SpecialCells(xlCellTypeFormulas, 1)
hier der gesamte Code
Private Sub CommandButton1_Click()
Dim lZeile As Long
lZeile = 3
'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
Do While Trim(CStr(Tabelle3.Cells(lZeile, 1).Value)) ""
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
Tabelle3.Cells(lZeile, 1) = CStr("Neuer Eintrag Zeile " & lZeile)
ListBox1.AddItem CStr("Neuer Eintrag Zeile " & lZeile)
ListBox1.ListIndex = ListBox1.ListCount - 1
End Sub
'Löschen Schaltfläche Ereignisroutine
Private Sub CommandButton2_Click()
Dim lZeile As Long
'Wenn kein Datensatz in der ListBox markiert wurde, wird die Routine beendet
If ListBox1.ListIndex = -1 Then Exit Sub
'Zum Löschen benötigen wir die Zeilennummer des ausgewählten Datensatzes
lZeile = 3 'Start in Zeile 5, Zeile 1 sind ja die Überschriften
'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
Do While Trim(CStr(Tabelle3.Cells(lZeile, 1).Value)) ""
'Datensatz ID Spalte mit selektiertem Eintrag der ListBox vergleichen
If ListBox1.Text = Trim(CStr(Tabelle3.Cells(lZeile, 1).Value)) Then
'Eintrag gefunden, die ganze Zeile wird nun gelöscht
Tabelle3.Rows(CStr(lZeile & ":" & lZeile)).Delete
Range("A3:J100").Select
ActiveWorkbook.Worksheets("MitarbeiterDB").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("MitarbeiterDB").Sort.SortFields.Add Key:=Range( _
"A3"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("MitarbeiterDB").Sort
.SetRange Range("A3:J100")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Die ListBox muss nun neu geladen werden!
Call UserForm_Initialize
If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
Exit Do 'Vorzeitiges Ende, da der Datensatz schon gefunden ist
End If
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
End Sub
'Speichern Schaltfläche Ereignisroutine
Private Sub CommandButton3_Click()
Dim lZeile As Long
'Wenn kein Datensatz in der ListBox markiert wurde, wird die Routine beendet
If ListBox1.ListIndex = -1 Then Exit Sub
'Wir müssen prüfen, ob die ID Spalte auch gefüllt ist!!
If Trim(CStr(TextBox1.Text)) = "" Then
'Meldung ausgeben
MsgBox "Sie müssen mindestens einen Namen eingeben!", vbCritical + vbOKOnly, "FEHLER!" _
'Abbrechen der Speicherroutine
Exit Sub
End If
'Ausbauoption: Prüfen, ob die ID in Tabelle1 Spalte 1 schon vorhanden ist!
'Zum Speichern benötigen wir die Zeilennummer des ausgewählten Datensatzes
lZeile = 3 'Start in Zeile 2, Zeile 1 sind ja die Überschriften
'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
Do While Trim(CStr(Tabelle3.Cells(lZeile, 1).Value)) ""
'Datensatz ID Spalte mit selektiertem Eintrag der ListBox vergleichen
If ListBox1.Text = Trim(CStr(Tabelle3.Cells(lZeile, 1).Value)) Then
'Eintrag gefunden, TextBoxen in die Zellen schreiben
Tabelle3.Cells(lZeile, 1).Value = Trim(CStr(TextBox1.Text))
Tabelle3.Cells(lZeile, 2).Value = Me.ComboBox1.Value
Tabelle3.Cells(lZeile, 3).Value = TextBox3.Text
If Me.CheckBox1 = True Then
Tabelle3.Cells(lZeile, 4).Value = "Ja"
Else: Tabelle3.Cells(lZeile, 4).Value = ""
End If
If Me.CheckBox2 = True Then
Tabelle3.Cells(lZeile, 5).Value = "Ja"
Else: Tabelle3.Cells(lZeile, 5).Value = ""
End If
If Me.CheckBox3 = True Then
Tabelle3.Cells(lZeile, 6).Value = "Ja"
Else: Tabelle3.Cells(lZeile, 6).Value = ""
End If
If Me.CheckBox4 = True Then
Tabelle3.Cells(lZeile, 7).Value = "Ja"
Else: Tabelle3.Cells(lZeile, 7).Value = ""
End If
If Me.CheckBox5 = True Then
Tabelle3.Cells(lZeile, 8).Value = "Ja"
Else: Tabelle3.Cells(lZeile, 8).Value = ""
End If
If Me.CheckBox6 = True Then
Tabelle3.Cells(lZeile, 9).Value = "Ja"
Else: Tabelle3.Cells(lZeile, 9).Value = ""
End If
Range("A3:J100").Select
ActiveWorkbook.Worksheets("MitarbeiterDB").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("MitarbeiterDB").Sort.SortFields.Add Key:=Range( _
"A3"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("MitarbeiterDB").Sort
.SetRange Range("A3:J100")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Die ListBox muss nun neu geladen werden
'allerdings nur, wenn sich der Name (ID) geändert hat
If ListBox1.Text Trim(CStr(TextBox1.Text)) Then
Call UserForm_Initialize
If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
End If
Exit Do 'Vorzeitiges Ende, da der Datensatz schon gefunden ist
End If
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
End Sub
'Beenden Schaltfläche Ereignisroutine
Private Sub CommandButton4_Click()
Unload Me
End Sub
'Klick auf die ListBox Ereignisroutine
Private Sub ListBox1_Click()
Dim lZeile As Long
Dim i As Variant
'Wenn der Benutzer einen Namen anklickt, suchen wir
'diesen in der Tabelle1 heraus und tragen die Daten
'in die TextBoxen ein.
'Wir löschen standardmäßig alle bisherigen TextBoxen-Inhalte
TextBox1 = ""
TextBox3 = ""
Me.ComboBox1.ListIndex = -1
'Nur wenn ein Eintrag selektiert/markiert ist
If ListBox1.ListIndex >= 0 Then
With Me.ListBox1
Me.ComboBox1 = .List(.ListIndex, 1)
End With
lZeile = 3 'Start in Zeile 2, Zeile 1 sind ja die Überschriften
'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
Do While Trim(CStr(Tabelle3.Cells(lZeile, 1).Value)) ""
'Wenn wir den Namen aus der ListBox1 in der Tabelle1 Spalte 1
'gefunden haben, übertragen wir die anderen Spalteninhalte
'in die TextBoxen!
If ListBox1.Text = Trim(CStr(Tabelle3.Cells(lZeile, 1).Value)) Then
'TextBoxen füllen
TextBox1 = Trim(CStr(Tabelle3.Cells(lZeile, 1).Value))
Me.ComboBox1 = Tabelle3.Cells(lZeile, 2).Value
TextBox3 = Tabelle3.Cells(lZeile, 3).Value
If Tabelle3.Cells(lZeile, 4).Value = "Ja" Then
Me.CheckBox1 = Tabelle3.Cells(lZeile, 4).Value
Me.CheckBox1 = True
Else: Me.CheckBox1 = False
End If
If Tabelle3.Cells(lZeile, 5).Value = "Ja" Then
Me.CheckBox2 = Tabelle3.Cells(lZeile, 5).Value
Me.CheckBox2 = True
Else: Me.CheckBox2 = False
End If
If Tabelle3.Cells(lZeile, 6).Value = "Ja" Then
Me.CheckBox3 = Tabelle3.Cells(lZeile, 6).Value
Me.CheckBox3 = True
Else: Me.CheckBox3 = False
End If
If Tabelle3.Cells(lZeile, 7).Value = "Ja" Then
Me.CheckBox4 = Tabelle3.Cells(lZeile, 7).Value
Me.CheckBox4 = True
Else: Me.CheckBox4 = False
End If
If Tabelle3.Cells(lZeile, 8).Value = "Ja" Then
Me.CheckBox5 = Tabelle3.Cells(lZeile, 8).Value
Me.CheckBox5 = True
Else: Me.CheckBox5 = False
If Tabelle3.Cells(lZeile, 9).Value = "Ja" Then
Me.CheckBox6 = Tabelle3.Cells(lZeile, 9).Value
Me.CheckBox6 = True
Else: Me.CheckBox6 = False
End If
End If
Exit Do 'Vorzeitiges Ende, da der Datensatz schon gefunden ist
End If
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
End If
End Sub
Private Sub UserForm_Activate()
'Wenn die Eingabemaske angezeigt wird, markieren wir den ersten Namen
'jedoch nur, wenn auch Einträge in der Liste stehen
If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
End Sub
'Startroutine, wird ausgeführt bevor die Eingabemaske angezeigt wird
Private Sub UserForm_Initialize()
Dim lZeile As Long
'Alle TextBoxen leer machen
TextBox1 = ""
TextBox3 = ""
ComboBox1.ListIndex = -1
'In dieser Routine laden wir alle vorhandenen
'Einträge in die ListBox1
ListBox1.Clear 'Zuerst einmal die Liste leeren
lZeile = 3 'Start in Zeile 2, Zeile 1 sind ja die Überschriften
'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
Do While Trim(CStr(Tabelle3.Cells(lZeile, 1).Value)) ""
'Aktuelle Zeile in die ListBox eintragen
ListBox1.AddItem Trim(CStr(Tabelle3.Cells(lZeile, 1).Value))
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
End Sub
Wobei ich aber denke, dass der Fehler in Tabelle 3 auftritt. dort ist ein Makro hinterlegt, dass dafür Sorgt, dass wenn ein Mitarbeiter gar nichts ist, oder Diätessen, soll er ausgeblendet werden.
Ich weiß nicht wo da der Debug Fehler ist
https://www.herber.de/bbs/user/93820.xlsm

Anzeige
Fehler ist schon in Deiner 1.Datei.... owT
17.11.2014 13:32:26
robert

AW: Fehler ist schon in Deiner 1.Datei.... owT
17.11.2014 13:35:00
Langmantl
@Robert
Danke für den Hinweis, aber das hilft mir nicht weiter, wäre nett wenn du etwas genauer dies beschreibst

Hilfe, noch keine Lösung
17.11.2014 14:50:46
Langmantl
Ich habe beim Ausführen gemerkt, dass der Debug Fehler nur dann auftritt, wenn ich über die Userform einen Eintrag in der Tabelle MitarbeiterDB löschen möchte. Geht aber nicht anders, da in Tabelle Essensliste und Feueralarmliste die Namen der Mitarbeiter per MatrixFunktion in die Tabellen eingefügt werden. Lösche ich manuell aus der Tabelle, kommt die Formel irgendwie durcheinander, es wird dann kein Name mehr angezeigt. Lösche ich über die Userform wird mir ein DebugFehler angezeigt.
Ich möchte darauf hinweisen, dass in der Tabelle MitarbeiterDB ein Ausgeblendetes Feld ist, dass ich benötige, damit er, sofern bei einem Mitarbeiter kein Hacken bei Isst mit steht (Also Monatag bis Freitag kein Ja, oder Diätessen) diesen aus der Tabelle ausblendet. dies funxt soweit ganz gut, allerdings hätte ich gerne Hilfe bei dem Debug Fehler.
Der kommt erst bei Löschen auf den Löschbutten der Userform. und sämtliche Einträge, die mit Matrixformel eingesetzt werden sind weg.
Fehlermeldung
Private Sub Worksheet_Calculate()
Dim rng As Range
Application.ScreenUpdating = False
With Tabelle2
.UsedRange.EntireRow.Hidden = False
Set rng = .Columns(34).SpecialCells(xlCellTypeFormulas, 1)
If Not rng Is Nothing Then
rng.EntireRow.Hidden = True
End If
End With
Application.ScreenUpdating = True
End Sub
Gelb hinterlegt ist
Set rng = .Columns(34).SpecialCells(xlCellTypeFormulas, 1)
hier die Datei:
https://www.herber.de/bbs/user/93822.xlsm

Anzeige
AW: Fehler ist schon in Deiner 1.Datei.... owT
17.11.2014 17:25:27
robert
Hi,
Zitat: funktioniert, habe aber jetzt das Problem, nachdem ich deinen Code eingegeben habe, und auf den Button löschen gehe zeigt er mir einen Debug Fehler an:
das klingt so, als ob der Code von fcs Schuld ist.
Deshalb mein Hinweis.

AW: Fehler ist schon in Deiner 1.Datei.... owT
18.11.2014 07:50:45
Langmantl
Na, das wollte ich so natürlich nicht damit aussagen, schon klar, dass der Fehler in der 1. Datei lag, aber einen Lösungsansatz wäre mir lieber gewesen, aber na, ja, ich habe ja die Lösung von Franz erhalten, danke

AW: Textbox austauschen gegen Combobox
17.11.2014 16:15:33
fcs
Hallo Benedikt,
das Problem fängt an mit dem kompletten Löschen der Zeile im Blatt "MitarbeiterDB" via Userform-Button. Dies löst eine Kettenreaktion aus:
1. In der Essensliste in Spalte B passt Excel die Formel an aber es werden nicht alle Teile korrekt angepasst.
Aus
=WENNFEHLER(INDEX(MitarbeiterDB!A:A;KKLEINSTE(WENN(MitarbeiterDB!$B$3:$B$100=Gruppenleiter!$A$8; ZEILE($3:$100));ZEILE()-4));"") 

wird
=WENNFEHLER(INDEX(MitarbeiterDB!A:A;KKLEINSTE(WENN(MitarbeiterDB!$B$3:$B$99=Gruppenleiter!$A$8; ZEILE($3:$100));ZEILE()-4));"") 

ZEILE($3:$100) wird nicht mit geändert in ZEILE($3:$99).
2. Durch den Fehler bleiben dann alle Namens-Zellen in Spalte B leer (Formelergebnis = "")
3. In Spalte AH liefern dadurch die Formeln in keiner Zeile eine 1.
4. Keine 1 in Spalte AH liefert den Fehler in Zeile
        Set rng = .Columns(34).SpecialCells(xlCellTypeFormulas, 1)
des Makros Private Sub Worksheet_Calculate()
Damit der Fehler ncht mehr auftritt sind folgende Maßnahmen notwendig:
1. Das Löschen-Makro im Userform darf nicht die komplette Zeile löschen sondern nur die Inhalte von Spalte A bis I in der Zeile mit dem löschenden Namen.
Private Sub CommandButton2_Click()
Dim lZeile As Long
'Wenn kein Datensatz in der ListBox markiert wurde, wird die Routine beendet
If ListBox1.ListIndex = -1 Then Exit Sub
'Zum Löschen benötigen wir die Zeilennummer des ausgewählten Datensatzes
lZeile = 3 'Start in Zeile 5, Zeile 1 sind ja die Überschriften
'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
Do While Trim(CStr(Tabelle3.Cells(lZeile, 1).Value))  ""
'Datensatz ID Spalte mit selektiertem Eintrag der ListBox vergleichen
If ListBox1.Text = Trim(CStr(Tabelle3.Cells(lZeile, 1).Value)) Then
'Eintrag gefunden, Inhalt in der Zeile Spalte A bis I wird nun gelöscht  '### geändert
With Tabelle3                                                  '### geändert
.Range(.Cells(lZeile, 1), .Cells(lZeile, 9)).ClearContents   '### geändert
End With                                                       '### geändert
Range("A3:J100").Select
ActiveWorkbook.Worksheets("MitarbeiterDB").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("MitarbeiterDB").Sort.SortFields.Add Key:=Range( _
"A3"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("MitarbeiterDB").Sort
.SetRange Range("A3:J100")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Die ListBox muss nun neu geladen werden!
Call UserForm_Initialize
If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
Exit Do 'Vorzeitiges Ende, da der Datensatz schon gefunden ist
End If
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
End Sub
2. Das Makro unter Blatt "MitarbeiterDB" ist zu ergänzen, so dass bei einem Fehler die nächste Zeile ausgeführt wird.
Private Sub Worksheet_Calculate()
Dim rng As Range
On Error Resume Next                          '##### ergänzt
Application.ScreenUpdating = False
With Tabelle2
.UsedRange.EntireRow.Hidden = False
Set rng = .Columns(34).SpecialCells(xlCellTypeFormulas, 1)
If Not rng Is Nothing Then
rng.EntireRow.Hidden = True
End If
End With
Application.ScreenUpdating = True
End Sub
3. In Blatt "Essensliste" müssen die Formeln in Spalte B ggf. korrigiert werden.
Formel in B5 als Matrix-Formel:
=WENNFEHLER(INDEX(MitarbeiterDB!A:A;KKLEINSTE(WENN(MitarbeiterDB!$B$3:$B$100=Gruppenleiter!$A$8; ZEILE($3:$100));ZEILE()-4));"") 

Diese Formel dann kopieren nach B6:B26.
Für die anderen Gruppenleiter dann mit entsprechend angepasster Formel.
Gruß
Franz
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige