VBA Eingabemaske mit mehreren Datensätzen

[JonasW]

Hallo liebes Forum,

ich stehe gerade vor einem größeren Problem. Ich bin gerade dabei eine Liste für unsere Kapazitätsplanung in Excel zu erstellen.

Die Eingabe soll über eine VBA-Eingabemaske erfolgen. Die Problematik dabei ist, dass die Eingabemaske nicht nur einen Datensatz (Zeile) erzeugen soll sondern gleich mehrere. Diese sind Aufgeteilt auf 2 Blätter. Weiterhin soll es im nachhinein möglich sein, die einzelnen Datensätze wieder gesammelt in die Eingabemaske zu laden, um daran Anpassungen vornehmen zu können.

Den Stand meiner Datei findet ihr im Anhang. Ein Beispiel für eine Eingabe findet ihr als Screenshot und die gewünschte Ausgabe habe ich in die Blätter eingetragen.

Wie würdet ihr dies lösen? Auch Ansätze wären schon hilfreich, dann könnte ich mich weiter im Informieren. 
Leider finde ich bisher nur relativ einfache Beispiele, die ich persönlich nicht wirklich an meine Liste anpassen kann.

Wenn ihr noch mehr Infos braucht kann ich gerne noch etwas ausholen.

Vielen Dank im Voraus :)

Liebe Grüße
Jonas

[JonasW]

Hallo Zusammen,

die obere Datei hat leider den falschen Dateityp. Hier nochmal mit Makros.

Viele Grüße :)
Jonas

[schauan]

Hallöchen,

da schauen wir mal Du hast in Deinem Code sehr viele Aktionen auskommentiert, auch einige Subs komplett. Sehr gut ist schon mla die umfangreiche Kommentierung, da weiß man, was dort geschehen soll.
Nun ist aber die Frage, womit hier begonnen werden soll. Mal schnell den Code komplett aktivieren, prüfen, korrigieren und erweitern, das wäre was für einen Dienstleister.
Wenn die Portionen klein genug sind, dann klappt das aber auch hier

Die Übergabe von neuen Einträgen lässt sich relativ einfach über eine Schleife realisieren. Dazu brauchst Du nur die Boxen im Userform der Reihe nach auf Einträge zu prüfen und in die Zellen übertragen. Für die Entscheidung, in welches Blatt die Einträge kommen, könntest DU mit den Namen der Boxen arbeiten. Entweder benennst Du die entsprechend um, z.B. Tabelle1_1, Tabelle2_1, oder TextBox1-5 gehen in Tabelle1, 6-10 in die 2, 11 bis 15 wieder in die 1 usw.

[JonasW]

Hallo Zusammen :),

danke für die Info, vielleicht können wir das als laufenden Thread angehen, in dem ich immer wieder die aktuellen Probleme schildere.

Einiges habe ich bereits geschafft. Den aktuellen Stand hänge ich wieder als Anhang an die Antwort. Zum testen habe ich im Anhang Beispielwerte eingetragen. Einfach die Maske öffnen und auf "Speichern" klicken, dann werden die Blätter ausgefüllt. "Beenden" funktioniert auch schon.

Erledigt:
- Der Export aus der Eingabemaske in die Excel Blätter.
- Die weitere Bearbeitung der Daten mit festen Formeln.

Offen:

1. Daten über die Eingabemaske wieder einlesen:

z.B.: Eine Listbox durchsucht die Spalte B nach Projektnamen und filtert dabei doppelte heraus. Bei gleichen werten soll die Position des obersten Eintrags übernommen werden. Anschließend werden die TextBoxen in Abhängigkeit von Ihrer Position zum obersten gefundenen Listbox Eintrag wieder befüllt. Jedes Projekt hat im Blatt "Projektstunden-LPH" exact 10 Zeilen, im Blatt Projektbeteiligte sind es 100.

2. Eine Prüfung anhand der Projektnummer oder Namen, ob ein Eintrag bereits vorhanden ist.

3. Es wäre schön wenn leere TextBoxen automatisch als 0 zählen, falls keine Einträge vorhanden sind. Wie könnte so etwas aussehen? 
Bisher habe ich 0 als Wert vorab eingetragen, der dann geändert werden muss.

Vielen Dank & Viele Grüße
Jonas

[schauan]

Hallo Jonas,

hier mal der erste Ansatz fuer das Füllen der Listbox. In der Liste hast Du mit dem Projekteintrag auch die erste Zeilennummer, durch Semikolon getrennt. Da müssten wir noch schauen, wo wir die Zahl verstecken - z.B. in einer zweiten Spalte der Listbox, die nicht angezeigt wird - oder sie stört nicht...

Code:

Sub FillList1()
'Variablendeklarationen
Dim colList As Collection, arrProjekt, iCnt&
'Uebernahme der Eintraege aus Spalte B, transponiert fuer 1D-Array
arrProjekt = WorksheetFunction.Transpose(Tabelle1.Columns(2).SpecialCells(xlCellTypeConstants))
'Setzen der Collection
Set colList = New Collection
'Bei Fehler weiter mit naechster Zeile
'Fuer Fuellung der Collection ohne Duplikate
On Error Resume Next
'Schleife ueber alle Arrayeintraege
For iCnt = 2 To UBound(arrProjekt)
  'Uebernahme des Arrayeintrages und des Arrayindexes.
  'Index entspricht der Zeilennummer des Eintrages.
  'Key ist der Eintrag. Dadurch Verhinderung der Duplikate
  colList.Add arrProjekt(iCnt) & ";" & iCnt, arrProjekt(iCnt)
'Ende Schleife ueber alle Arrayeintraege
Next
'Ende Bei Fehler weiter mit naechster Zeile
On Error GoTo 0
'Redimensionierung des Array entsprechend Anzahl Eintraege der Collection
ReDim arrProjekt(1 To colList.Count)
'Schleife ueber alle Collectioneintraege
For iCnt = 1 To colList.Count
  'Uebernahme in Array
  arrProjekt(iCnt) = colList(iCnt)
'Ende Schleife ueber alle Collectioneintraege
Next
'Fuellen der Listbox
Eingabemaske.ListBox1.List = arrProjekt
End Sub

Im Userform brauchst Du dann noch den Code

Code:

Private Sub UserForm_Initialize()
FillList1
End Sub

[JonasW]

Hallo Andre,

funktioniert gut. Danke! Einziges Manko, wenn kein Eintrag vorhanden ist, erscheint eine Fehlermeldung.
Ich versuche jetzt mal den Code zu verstehen und das selbe nur versteckt über eine Kombination von zwei ListBoxen für die  zweite Tabelle zu generieren. Dann hätten wir für jeden Projektnamen den Wert der Zeile in der der Name zum ersten mal steht. Von da aus sollte es möglich sein auf die einzelnen TextBoxen zuzugreifen.

Viele Grüße
Jonas

[Rabe]

Hi,

also der Code für CommandButton3 ("Speichern") ist ja seeeehr lang, dort wird 10x für 10 Mitarbeiter eine Zeile erzeugt.

Kann das nicht über eine (evtl. verschachtelte) Schleife zum Auslesen der Textboxen 1-10 gelöst werden?

Außerdem schlage ich zum Verkürzen der Code-Zeilen die Verwendung einer With-Schleife vor (könnten auch hier die Zahlen 1-9 durch eine For-Schleife ersetzt werden?):

Code:

With Sheets("Projektstunden-LPH")
      ' Eintragen der Projektstunden aufgeteilt in Leistungsphasen
      ' Pro Leistungsphase wird eine Zeile erzeugt die Projektnummer, Wertung, Datum Anfang, Datum Ende und die geplanten Stunden enthält.
      'Leistungsphase 1
      .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(, 6) = Array(pnr.Text & "-1", pbez.Text, wlph1.Value * 0.01, CDate(Me.vlph1.Value), CDate(Me.blph1.Value), pstd.Value * (wlph1.Value * 0.01))
      'Leistungsphase 2
      .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(, 6) = Array(pnr.Text & "-2", pbez.Text, wlph2.Value * 0.01, CDate(Me.vlph2.Value), CDate(Me.blph2.Value), pstd.Value * (wlph2.Value * 0.01))
      'Leistungsphase 3
      .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(, 6) = Array(pnr.Text & "-3", pbez.Text, wlph3.Value * 0.01, CDate(Me.vlph3.Value), CDate(Me.blph3.Value), pstd.Value * (wlph3.Value * 0.01))
      'Leistungsphase 4
      .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(, 6) = Array(pnr.Text & "-4", pbez.Text, wlph4.Value * 0.01, CDate(Me.vlph4.Value), CDate(Me.blph4.Value), pstd.Value * (wlph4.Value * 0.01))
      'Leistungsphase 5
      .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(, 6) = Array(pnr.Text & "-5", pbez.Text, wlph5.Value * 0.01, CDate(Me.vlph5.Value), CDate(Me.blph5.Value), pstd.Value * (wlph5.Value * 0.01))
      'Leistungsphase 6
      .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(, 6) = Array(pnr.Text & "-6", pbez.Text, wlph6.Value * 0.01, CDate(Me.vlph6.Value), CDate(Me.blph6.Value), pstd.Value * (wlph6.Value * 0.01))
      'Leistungsphase 7
      .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(, 6) = Array(pnr.Text & "-7", pbez.Text, wlph7.Value * 0.01, CDate(Me.vlph7.Value), CDate(Me.blph7.Value), pstd.Value * (wlph7.Value * 0.01))
      'Leistungsphase 8
      .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(, 6) = Array(pnr.Text & "-8", pbez.Text, wlph8.Value * 0.01, CDate(Me.vlph8.Value), CDate(Me.blph8.Value), pstd.Value * (wlph8.Value * 0.01))
      'Leistungsphase 9
      .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(, 6) = Array(pnr.Text & "-9", pbez.Text, wlph9.Value * 0.01, CDate(Me.vlph9.Value), CDate(Me.blph9.Value), pstd.Value * (wlph9.Value * 0.01))
      'Beauftragung
      .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(, 6) = Array(pnr.Text, pbez.Text, 1, CDate(Me.va.Value), CDate(Me.ba.Value), pstd.Value)
   End With

[JonasW]

Hi Ralf,

danke für die Anmerkung, ich probiere es gleich mal aus!

Für das wiederfinden der Projekte über die ListBox versuche ich gerade folgendes:
Da er die Spalten von oben nach unten nach Projektnamen durchsucht werden, bräuchten wir so die Nummer hinter dem Projektnamen in der nicht mehr.

Über .Offset gehe ich dann die nächsten 10 Zeilen bzw. beim Blatt "Projektbeteiligte" 100 Zeilen durch. Geht das einfacher?

Code:

Private Sub ListBox1_Click()
  Dim lZeile As Long
    'Wenn der Benutzer einen Namen anklickt, suchen wir
    'diesen in der Tabelle1 heraus und tragen die Daten
    'in die TextBoxen ein.
   
    'Löschen aller Textboxen, die sich auf Projektstunden-LPH beziehen
    pnr = ""
    pbez = ""
    pstd = ""
    wlph1 = ""
    wlph2 = ""
    wlph3 = ""
    wlph4 = ""
    wlph5 = ""
    wlph6 = ""
    wlph7 = ""
    wlph8 = ""
    wlph9 = ""
    vlph1 = ""
    vlph2 = ""
    vlph3 = ""
    vlph4 = ""
    vlph5 = ""
    vlph6 = ""
    vlph7 = ""
    vlph8 = ""
    vlph9 = ""
    blph1 = ""
    blph2 = ""
    blph3 = ""
    blph4 = ""
    blph5 = ""
    blph6 = ""
    blph7 = ""
    blph8 = ""
    blph9 = ""
    va = ""
    ba = ""

    'Nur wenn ein Eintrag selektiert/markiert ist
    If ListBox1.ListIndex >= 0 Then
   
'Import aus Projektstunden
   
        lZeile = 2 'Start in Zeile 2, Zeile 1 sind ja die Überschriften
        'Schleife solange etwas in der ersten Spalte in Projektstunden drin steht
        Do While Trim(CStr(Projektstunden.Cells(lZeile, 1).Value)) <> ""
       
            'Wenn wir den Namen aus der ListBox1 in der Projektstunden Spalte 2
            'gefunden haben, übertragen wir die anderen Spalteninhalte
            'in die TextBoxen!
            If ListBox1.Text = Trim(CStr(Projektstunden.Cells(lZeile, 2).Value)) Then
           
                'TextBoxen füllen
                TextBox1 = Trim(CStr(Projektstunden.Cells(lZeile, 1).Value))
                wlph1 = Projektstunden.Cells(lZeile, 3).Value * 100
                vlph1 = Projektstunden.Cells(lZeile, 4).Value
                blph1 = Projektstunden.Cells(lZeile, 5).Value
                wlph2 = Projektstunden.Cells(lZeile, 3).Offset(1, 0).Value * 100
                               
                Exit Do 'Vorzeitiges Ende, da der Datensatz schon gefunden ist
           
            End If
       
            lZeile = lZeile + 1 'Nächste Zeile bearbeiten
       
        Loop
       
    End If
   
   
Dim pZeile As Long
'Import aus Projektbeteiligte

    ma1 = ""
    ma2 = ""
    ma3 = ""
    ma4 = ""
    ma5 = ""
    ma6 = ""
    ma7 = ""
    ma8 = ""
    ma9 = ""
    ma10 = ""

      If ListBox1.ListIndex >= 0 Then
       
        pZeile = 2 'Start in Zeile 2, Zeile 1 sind ja die Überschriften
        Do While Trim(CStr(Projektbeteiligte.Cells(pZeile, 1).Value)) <> ""
            If ListBox1.Text = Trim(CStr(Projektbeteiligte.Cells(pZeile, 2).Value)) Then
               ma1 = Projektbeteiligte.Cells(pZeile, 3).Value
   
    Exit Do 'Vorzeitiges Ende, da der Datensatz schon gefunden ist
           
            End If
       
            tZeile = tZeile + 1 'Nächste Zeile bearbeiten
       
        Loop
       
    End If
   
   
   
   
End Sub

Viele Grüße
Jonas

[Rabe]

Hi Jonas,

Für das wiederfinden der Projekte über die ListBox versuche ich gerade folgendes:
Da er die Spalten von oben nach unten nach Projektnamen durchsucht werden, bräuchten wir so die Nummer hinter dem Projektnamen in der nicht mehr.

ich habe Dir Deinen ListBox1-Code etwas verkürzt:

Private Sub ListBox1_Click()
   'Wenn der Benutzer einen Namen anklickt, suchen wir diesen in der Tabelle1 heraus 
   'und tragen die Daten in die TextBoxen ein. 
   Dim lZeile As Long
   Dim pZeile As Long
   Dim i As Long
   
   'Löschen aller Textboxen, die sich auf Projektstunden-LPH beziehen 
   pnr = ""
   pbez = ""
   pstd = ""
   For i = 1 To 9
      Me.Controls("wlph" & i).Value = ""
      Me.Controls("vlph" & i).Value = ""
      Me.Controls("blph" & i).Value = ""
   Next i
   va = ""
   ba = ""
   
   'Nur wenn ein Eintrag selektiert/markiert ist 
   If ListBox1.ListIndex >= 0 Then
      
      'Import aus Projektstunden 
      'Schleife solange etwas in der ersten Spalte in Projektstunden drin steht 
      For lZeile = 2 To Sheets("Projektstunden").Cells(Rows.Count, 1).End(xlUp)
         
         'Wenn wir den Namen aus der ListBox1 in der Projektstunden Spalte 2 gefunden haben, 
         'übertragen wir die anderen Spalteninhalte in die TextBoxen! 
         If ListBox1.Text = Trim(CStr(Projektstunden.Cells(lZeile, 2).Value)) Then
            
            'TextBoxen füllen 
            TextBox1 = Trim(CStr(Projektstunden.Cells(lZeile, 1).Value))
            wlph1 = Projektstunden.Cells(lZeile, 3).Value * 100
            vlph1 = Projektstunden.Cells(lZeile, 4).Value
            blph1 = Projektstunden.Cells(lZeile, 5).Value
            wlph2 = Projektstunden.Cells(lZeile, 3).Offset(1, 0).Value * 100
            'hier die weiteren Textboxen analog zu den oberen For-Schleifen? 
            Exit For 'Vorzeitiges Ende, da der Datensatz schon gefunden ist 
         End If
      Next lZeile
   End If
   
   'Import aus Projektbeteiligte 
   For i = 1 To 10
      Me.Controls("ma" & i).Value = ""
   Next i
   
   If ListBox1.ListIndex >= 0 Then
      For pZeile = 2 To Sheets("Projektbeteiligte").Cells(Rows.Count, 1).End(xlUp)
         If ListBox1.Text = Trim(CStr(Projektbeteiligte.Cells(pZeile, 2).Value)) Then
            ma1 = Projektbeteiligte.Cells(pZeile, 3).Value
            'hier die anderen 9 MA analog zu der obigen For-Schleife? 
            Exit For 'Vorzeitiges Ende, da der Datensatz schon gefunden ist 
         End If
      Next pZeile
   End If
End Sub

und hier den "Speichern"-Code:

Private Sub CommandButton3_Click()
   Dim a As Long
   Dim i As Long
   Dim j As Long
   
   With Sheets("Projektstunden-LPH")
      ' Eintragen der Projektstunden aufgeteilt in Leistungsphasen 
      ' Pro Leistungsphase wird eine Zeile erzeugt die Projektnummer, Wertung, Datum Anfang, Datum Ende und die geplanten Stunden enthält. 
      For i = 1 To 9
         'Leistungsphase 1-9 
         .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(, 6) = Array(pnr.Text & "-" & i, pbez.Text, Me.Controls("wlph" & i).Value * 0.01, _
             CDate(Me.Controls("vlph" & i).Value), CDate(Me.Controls("blph" & i).Value), pstd.Value * (Me.Controls("wlph" & i).Value * 0.01))
      Next i
      'Beauftragung 
      .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(, 6) = Array(pnr.Text, pbez.Text, 1, CDate(Me.va.Value), CDate(Me.ba.Value), pstd.Value)
   End With
   
   ' Eintragen der Projektbeteiligten mit dem jeweiligen Schlüssel aufgeteilt in Leistungsphasen 
   ' Pro Leistungsphase werden 10 Zeilen erzeugt, eine pro Mitarbeiter. 
   For j = 1 To 9
      'LPH1-9 
      For i = 1 To 10
         'MA1-10 
         Sheets("Projektbeteiligte").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(, 4) = Array(pnr.Value & "-" & j, pbez.Text, _
         Me.Controls("ma" & i).Text, Me.Controls("ma" & i & "lph" & j).Value * 0.01)
      Next i
   Next j
   ' Beauftragung 
   For i = 1 To 10
      'MA1-10 
      Sheets("Projektbeteiligte").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(, 4) = Array(pnr.Value, pbez.Text, _
      Me.Controls("ma" & i).Text, Me.Controls("ma" & i & "a").Value * 0.01)
   Next i
   
   MsgBox ("Projekt wurde gespeichert")
   
End Sub

teste es mal aus, das geht hier nicht, da bei mir die Listbox nicht gefüllt wird.

[JonasW]

Hallo Ralf,

vielen Dank!

Beim testen kommt ein Fehler "Index außerhalb des gültigen Bereichs" in folgender Zeile:

Code:

    For lZeile = 2 To Sheets("Projektstunden").Cells(Rows.Count, 1).End(xlUp)

Wenn ich das richtig sehe wird jetzt aber nur der teil importiert den ich schon geschrieben hatte oder ?
Das Ziel ist, dass alle TextBoxen wieder den bei der Eingabe eingegebenen Wert erhalten und das ganze dann mit dem "Speichern" Button bei Änderungen überschrieben wird.

Leider hat mein Import aus dem Blatt "Projektbeteiligte" nur bei einem Projekt funktioniert. Sobald es 2 oder mehr werden hängt sich mein Excel auf.

Ich hänge dir meine aktuelle Datei als Anhang dran.

Viele Grüße
Jonas