Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema CheckBox
BildScreenshot zu CheckBox CheckBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema CommandButton
BildScreenshot zu CommandButton CommandButton-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Userform
BildScreenshot zu Userform Userform-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Label
BildScreenshot zu Label Label-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema ListBox
BildScreenshot zu ListBox ListBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema TextBox
BildScreenshot zu TextBox TextBox-Seite mit Beispielarbeitsmappe aufrufen

Textbox austauschen gegen Combobox

Betrifft: Textbox austauschen gegen Combobox von: Langmantl
Geschrieben am: 17.11.2014 11:02:38

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

  

Betrifft: AW: Textbox austauschen gegen Combobox von: fcs
Geschrieben am: 17.11.2014 12:19:49

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



  

Betrifft: AW: Textbox austauschen gegen Combobox von: Langmantl
Geschrieben am: 17.11.2014 13:00:51

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


  

Betrifft: Fehler ist schon in Deiner 1.Datei.... owT von: robert
Geschrieben am: 17.11.2014 13:32:26




  

Betrifft: AW: Fehler ist schon in Deiner 1.Datei.... owT von: Langmantl
Geschrieben am: 17.11.2014 13:35:00

@Robert
Danke für den Hinweis, aber das hilft mir nicht weiter, wäre nett wenn du etwas genauer dies beschreibst


  

Betrifft: Hilfe, noch keine Lösung von: Langmantl
Geschrieben am: 17.11.2014 14:50:46

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


  

Betrifft: AW: Fehler ist schon in Deiner 1.Datei.... owT von: robert
Geschrieben am: 17.11.2014 17:25:27

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.


  

Betrifft: AW: Fehler ist schon in Deiner 1.Datei.... owT von: Langmantl
Geschrieben am: 18.11.2014 07:50:45

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


  

Betrifft: AW: Textbox austauschen gegen Combobox von: fcs
Geschrieben am: 17.11.2014 16:15:33

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


 

Beiträge aus den Excel-Beispielen zum Thema "Textbox austauschen gegen Combobox"