Userform zur Dateneintragung

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
UserForm TextBox
Bild

Betrifft: Userform zur Dateneintragung
von: Peter
Geschrieben am: 17.07.2015 08:36:48

Hallo zusammen:
Ich bin Anfänger in VBA und tu mir mit einigen Dingen noch recht schwer bzw. schreibe vieles viel zu umständlich.
Daher meine sicher recht leichte Frage:
Ich möchte eine Userform erstellen, die bestimmte Felder besitzt. Diese werden nach einer Bestätigung ausgelesen und in entsprechende Felder in Excel geschrieben.
Ich habe mal einen Screenshot mit angehängt, der zeigt, wie die Felder in Excel aufgebaut sind.
Userbild
Dem Benutzer soll nun eine Userform angezeigt werden, in der er das Jahr und die Kostenstelle (KS) auswählt. Anschließend trägt er die Daten für Niveau, Vorgänge und Datum ein (es gibt zwei Bewertungen pro Jahr, daher B1 und B2).
Nach einem Klick auf Okay sollen die Daten dann in die entsprechenden Zellen geschrieben werden.
Vielleicht geht das sehr einfach, eventuell ist das ganze aber auch zu kompliziert?
Ich denke einfach, es sieht schöner aus und macht es sehr benutzerfreundlich.
Vielen Dank für eure Bemühungen.
Peter

Bild

Betrifft: AW: Eine Anmerkung...
von: Michael (migre)
Geschrieben am: 17.07.2015 09:27:46
Hallo Peter!
Keine Lösung, daher noch offen, wollte Dir diesbezüglich nur (m)eine Anmerkung mitgeben:

Ich denke einfach, es sieht schöner aus und macht es sehr benutzerfreundlich.
Du hast eine sehr klar strukturierte Tabelle aufgebaut, die aus meiner Sicht schon recht benutzerfreundlich ist - hinsichtlich "richtiger Eingaben" kannst Du ja (evtl. machst Du das schon, ist ja nur ein Bild von der Tabelle) noch zB auf Datenüberprüfung/Gültigkeit setzen etc.
Warum willst Du hier wirklich noch eine UserForm einsetzen? Einfach nur weil's prinzipiell möglich ist oder irgendwie "cooler" ausschaut? Ich persönlich bin immer ein Fan von Automatisierungen bzw. VBA - aber gerade bei UserFormen hab ich oft den Eindruck, dass der Aufwand nicht lohnt, wenn man die Tabelle von Anfang an "sauber" gestaltet - und UserForm-Spielereien werden sehr schnell sehr aufwändig.
Also mein Tipp: Überleg Dir evtl., wenn es nicht unabdingbar ist, ob eine UserForm (bzw. VBA) wirklich sein muss.
LG
Michael

Bild

Betrifft: AW: Eine Anmerkung...
von: Peter
Geschrieben am: 17.07.2015 09:33:10
Hallo Michael,
vielen Danl für deine Anregung.
Ich würde es gerne mit VBA lösen, da ich zum einen dazulernen will, was alles machbar ist und zum anderen ist der Screenshot nur ein kleiner Ausschnitt der Tabelle. Die Tabelle geht bis ins Jahr 2020 und hat auch nach unten hin weitere Kostenstellen. Im Gesamtbild ist sie dann eben nicht mehr so benutzerfreundlich, da man scrollen muss. Hätte man eine Eingabemaske, dann wäre das eben nochmal einen Tick schöner :)
Aber falls das den Aufwand nicht Wert ist, ist das zwar schade, aber okay :)
Ich kann mit meinen Kenntnissen nur leider noch nicht die Arbeit, die hinter so etwas steckt, abschätzen :)
LG, Peter

Bild

Betrifft: AW: Dann wieder offen | Beispielmappe!
von: Michael (migre)
Geschrieben am: 17.07.2015 10:23:21
Hallo Peter!
Nachdem Du auf jeden Falle eine VBA-Lösung suchst, stelle ich den Faden nochmals offen, da Deine letzte Antwort den Beitrag sonst nicht mehr in den offenen Fragen angezeigt hätte - achte darauf das Kontrollkästchen zu markieren, wenn Du den Beitrag weiterhin offen (=unbeantwortet) anzeigen willst.
Bzgl. einer VBA-Lösung ist es dann aber schon sinnvoll, dass Du die gesamte Tabelle hier hochlädst, damit Dir jemand sinnvoll eine Eingabemaske programmieren kann - das ist mit dem Ausschnitt sonst ein ziemlich unmögliches Unterfangen. Du schreibst ja selbst, dass die Tabelle wesentlich umfangreicher ist, als in dem Ausschnitt.
LG
Michael

Bild

Betrifft: AW: Eingabemaske | Noch offen
von: Peter
Geschrieben am: 17.07.2015 10:33:42
Hallo Michael,
danke für den Hinweis. Das Kästchen ist aktiviert und ich hoffe, dass der Beitrag jetzt noch als offen dargestellt wird.
https://www.herber.de/bbs/user/98889.xlsx
Hier ist die vollständige Tabelle.
Vielen Dank für deine und eure Unterstützung.
LG Peter

Bild

Betrifft: AW: Weiter offen, ich kann erst...
von: Michael (migre)
Geschrieben am: 17.07.2015 13:43:29
Hallo Peter,
... nach dem Wochenende wieder ins Forum schauen. Evtl. kann ich Dir nächste Woche noch was anbieten diesbzgl., mal sehen wie es von der Zeit ausschaut; wie gesagt, das wird schnell "größer".
Evtl. klinkt sich bis dahin noch jemand anderes ein.
Schönes Wochenende!
Michael

Bild

Betrifft: AW: Weiter offen, ich kann erst...
von: Peter
Geschrieben am: 17.07.2015 15:00:21
Hallo Michael,
ich danke dir für deine Unterstüzung! Ich würde mich sehr über eine Benachrichtigung freuen und wünsche dir bis dahin ein schönes Wochenende :)
Viele Grüße,
Peter

Bild

Betrifft: AW: Eingabemaske | Noch offen
von: Sepp
Geschrieben am: 19.07.2015 13:57:57
Hallo Peter,
wie Micheal schon angedeutet hat, das wird aufwändiger als gedacht.
Ein erster Ansatz.
https://www.herber.de/bbs/user/98921.xlsm

Gruß Sepp


Bild

Betrifft: AW: Eingabemaske | Noch offen
von: Sepp
Geschrieben am: 19.07.2015 15:53:41
Hallo Michael,
anbei eine verbesserte Version. Für weitere Änderungen ist zuerst dein Input gefragt.
https://www.herber.de/bbs/user/98922.xlsm

Gruß Sepp


Bild

Betrifft: AW: Eingabemaske | Noch offen
von: Peter
Geschrieben am: 20.07.2015 08:36:11
Hallo Sepp,
tausend Dank für deine Hilfe! Das ist genau das, was ich wollte :)
Ich habe die Userform jetzt mal in mein Dokument übernommen (mit Userform exportieren/importieren) und natürlich funktioniert es jetzt nicht mehr.
Aufbau ist genau der gleiche, d.h. Zellen sind identisch. Die Userform habe ich in "Dateneingabe" umbenannt und auch im Modul den Befehl auf Dateneingabe.show umbenannt.
Im Code musste ich den Teil umbenennen:

Private Sub Dateneingabe_Activate()
sDim lngYear As Long, vntTmp As Variant, vntList As Variant
Dim lngI As Long
With ActiveSheet
  For lngYear = Application.Min(.Rows(2)) To Application.Max(.Rows(2))
    cboYear.AddItem CStr(lngYear)
  Next
  cboYear = Year(Date)
  
  vntTmp = .Range("A5:A" & Application.Max(5, .Cells(.Rows.Count, 1).End(xlUp).Row))
  vntList = toArraySorted(vntTmp)
  cboKS.ListRows = 20
  cboKS.List = vntList
  cboVB1.List = Array("", "1", "2", "3", "3+")
  cboVB2.List = Array("", "1", "2", "3", "3+")
  For lngI = 1 To DateSerial(cboYear, 12, 31) - DateSerial(cboYear, 1, 1) + 1
    cboDB1.AddItem Format(DateSerial(cboYear, 1, lngI))
  Next
  cboDB1.ListRows = 20
  cboDB2.ListRows = 20
  cboDB2.List = cboDB1.List
End With
setData
End Sub
sonst kommt ein Syntaxfehler. Jetzt passiert folgendes:
Die Variablenbestimmung "sDim lngYear As Long, vntTmp As Variant, vntList As Variant" ist rot und die offene Userform hat keinen Inhalt mehr in den Dropdownfeldern.
Muss ich noch mehr umbenennen?
Ein weiterer Punkt:
Im Sheet steht weiter unten nochmal die Auflistung der Kostenstellen, genau in der selben Spalte. Kann es dann zu Problemen führen, wenn dein Code nach der Kostenstelle sucht und sie 2x findet?
Vielen Dank Sepp, du bist mir hier wirklich eine riesen Hilfe!
Einen guten Start in die Woche,
Peter

Bild

Betrifft: AW: Eingabemaske | Noch offen
von: Peter
Geschrieben am: 20.07.2015 08:49:32
Sorry, kurzer Nachtrag:
Beim Importieren hat es die Zeile im Code umbenannt?
sDim lngYear As Long, vntTmp As Variant, vntList As Variant
lautete zuvor
Dim lngYear As Long, vntTmp As Variant, vntList As Variant
jetzt funktioniert es auch..
Also bitte die letzte Nachricht von mir ignorieren!
Ich bin dir sehr dankbar Sepp.
Ich hätte noch zwei Anregungen:
1. Niveaueingabe
Ich denke es wäre einfacher, wenn der Benutzer nur die Zahl eintippen muss und das Prozentzeichen angehängt wird. In der Userform könnte dann hinter dem Eingabefeld ein festes Prozentzeichen stehen, dann wird direkt ersichtlich, was eingetragen werden muss.
2. Datum
Für meine Zwecke wäre es am besten, wenn das Datum im Format DD.MM. eingetragen wird, ohne das Jahr.
Vielen lieben Dank,
Peter

Bild

Betrifft: AW: Sehr schöner Ansatz...
von: Michael (migre)
Geschrieben am: 20.07.2015 13:48:19
Sepp,
...vielen Dank für Dein Einspringen. Sehr schön gelöst! Das hätte ich diese Woche wohl nicht mehr hinbekommen (aber zudem muss gesagt sein: Ich hasse UserForm-Basteleien ;-)).
@ Peter: Aus Deinen Antworten entnehme ich, dass Du mit Sepps Hilfe zufrieden bist. Ich werde mich daher aus diesem Faden verabschieden. Viel Erfolg noch!
LG
Michael

Bild

Betrifft: AW: Sepps Ansatz
von: Peter
Geschrieben am: 20.07.2015 14:55:05
Hallo Michael & Sepp,
zunächst nochmal vielen Dank dir Michael, dass du mich gerne unterstützt hättest. Sepp hat mir hier aber wirklich genau das geliefert, was in meinem Kopf vorgeschwebt hat.
Danke an euch beide für die super Hilfe!
@Sepp:
Der Punkt mit dem Datumsformat hat sich erledigt.
Bleibt nur noch die Eingabe des Niveaus wie in meinem letzten Beitrag erwähnt.
Lieben Dank und viele Grüße
Peter

Bild

Betrifft: AW: Sepps Ansatz
von: Peter
Geschrieben am: 20.07.2015 14:57:15
Sorry, vergessen das Ganze noch offen zu lassen

Bild

Betrifft: AW: Sepps Ansatz
von: Sepp
Geschrieben am: 20.07.2015 19:12:03
Hallo Peter,
anbei eine angepasste version. ich hoffe, dass ich nichts übersehen habe.
https://www.herber.de/bbs/user/98954.xlsm

Gruß Sepp


Bild

Betrifft: AW: Sepps Ansatz
von: Peter
Geschrieben am: 21.07.2015 08:30:18
Hallo Sepp,
vielen liebe Dank, die Userform erfüllt nun genau ihren Zweck!
Du warst mir wirklich eine große Hilfe.
Anbei ein letzter Punkt:
Könntest du mir eventuell den Code noch etwas genauer erklären? Einiges kann ich nachvollziehen, bei anderem jedoch kommen nur Fragezeichen auf. Ich denke, dass da so viel drinsteckt, was mir in Zukunft weiterhelfen kann, dass ich es gerne wissen würde.
Vielen Dank und Gruß,
Peter

Bild

Betrifft: AW: Sepps Ansatz
von: Sepp
Geschrieben am: 21.07.2015 18:49:24
Hallo Peter,
na wirklich viel gibt es da nicht zu erklären, anbei der Code mit ein paar Kommentaren.

' **********************************************************************
' Modul: UserForm1 Typ: Userform
' **********************************************************************

Option Explicit

Private Sub cboKS_Change()
  setData
End Sub


Private Sub cboYear_Change()
  Dim lngI As Long
  
  cboDB1.Clear
  cboDB1 = ""
  cboDB2.Clear
  cboDB2 = ""
  'Datum vom 1.1. bis 31.12. in Combobox eintragen
  For lngI = 1 To DateSerial(cboYear, 12, 31) - DateSerial(cboYear, 1, 1) + 1
    cboDB1.AddItem Format(DateSerial(cboYear, 1, lngI))
  Next
  'Liste aus 1. Combobox in zweite übertragen
  cboDB2.List = cboDB1.List
  
  setData
End Sub


Private Sub cmdClose_Click()
  Unload Me
End Sub


Private Sub cmdEntry_Click()
  Dim vntRet As Variant, vntRow As Variant
  'Daten eintragen
  On Error Resume Next
  With ActiveSheet
    vntRet = Application.Match(Clng(cboYear), .Rows(2), 0) 'Jahr finden
    If IsNumeric(vntRet) Then
      vntRow = Application.Match(Clng(cboKS), Columns(1), 0) 'KS finden
      If IsNumeric(vntRow) Then
        'Daten eintragen wenn Eintrag in TextBox/Combobox vorhanden
        If Len(txtNB1) Then .Cells(vntRow, vntRet) = txtNB1 / 100 Else: .Cells(vntRow, vntRet) = ""
        If Len(txtNB2) Then .Cells(vntRow, vntRet + 1) = txtNB2 / 100 Else: .Cells(vntRow, vntRet + 1) = ""
        If Len(cboVB1) Then .Cells(vntRow, vntRet + 2) = cboVB1 Else: .Cells(vntRow, vntRet + 2) = ""
        If Len(cboVB2) Then .Cells(vntRow, vntRet + 3) = cboVB2 Else: .Cells(vntRow, vntRet + 3) = ""
        If Len(cboDB1) Then .Cells(vntRow, vntRet + 4) = CDate(cboDB1) Else: .Cells(vntRow, vntRet + 4) = ""
        If Len(cboDB2) Then .Cells(vntRow, vntRet + 5) = CDate(cboDB2) Else: .Cells(vntRow, vntRet + 5) = ""
      End If
    End If
  End With
End Sub


Private Sub txtNB1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
  'Nur Zahlen 0-9 und max 100 zulassen
  Select Case KeyAscii
    Case 47 To 58
      If Len(txtNB1) > 2 Then KeyAscii = 0
      If Clng(txtNB1 & "0") > 100 Then txtNB1 = "100"
    Case Else
      KeyAscii = 0
  End Select
End Sub

Private Sub txtNB2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
  'Nur Zahlen 0-9 und max 100 zulassen
  Select Case KeyAscii
    Case 47 To 58
      If Len(txtNB2) > 2 Then KeyAscii = 0
      If Clng(txtNB2 & "0") > 100 Then txtNB2 = "100"
    Case Else
      KeyAscii = 0
  End Select
End Sub


Private Sub UserForm_Activate()
  Dim lngYear As Long, vntTmp As Variant, vntList As Variant
  Dim lngI As Long
  
  With ActiveSheet
    'Jahres-Combobox füllen
    For lngYear = Application.Min(.Rows(2)) To Application.Max(.Rows(2))
      cboYear.AddItem CStr(lngYear)
    Next
    cboYear = Year(Date)
    'KS in Array speichern (Spalte A)
    vntTmp = .Range("A5:A" & Application.Max(5, .Cells(.Rows.Count, 1).End(xlUp).Row))
    'Liste bereinigen und sortieren
    vntList = toArraySorted(vntTmp)
    cboKS.ListRows = 20
    cboKS.List = vntList 'Liste zuweisen
    'Berwertungs-Boxen füllen
    cboVB1.List = Array("", "1", "2", "3", "3+")
    cboVB2.List = Array("", "1", "2", "3", "3+")
    'datumsboxen füllen
    For lngI = 1 To DateSerial(cboYear, 12, 31) - DateSerial(cboYear, 1, 1) + 1
      cboDB1.AddItem Format(DateSerial(cboYear, 1, lngI))
    Next
    cboDB1.ListRows = 20
    cboDB2.ListRows = 20
    cboDB2.List = cboDB1.List
  End With
  setData
End Sub


Private Sub setData()
  Dim vntRet As Variant, vntRow As Variant
  'Daten aktualiesieren
  On Error Resume Next
  
  With ActiveSheet
    vntRet = Application.Match(Clng(cboYear), .Rows(2), 0) 'Jahr suchen
    If IsNumeric(vntRet) Then
      vntRow = Application.Match(Clng(cboKS), Columns(1), 0) 'KS suchen
      If IsNumeric(vntRow) Then
        txtNB1 = Replace(.Cells(vntRow, vntRet).Text, "%", "")
        txtNB2 = Replace(.Cells(vntRow, vntRet + 1).Text, "%", "")
        cboVB1 = .Cells(vntRow, vntRet + 2).Text
        cboVB2 = .Cells(vntRow, vntRet + 3).Text
        cboDB1 = .Cells(vntRow, vntRet + 4)
        cboDB2 = .Cells(vntRow, vntRet + 5)
      End If
    End If
  End With
End Sub


'Funktion um Array zu bereinigen (doppler) und zu sortieren
Private Function toArraySorted(Field As Variant, Optional Uniqe As Boolean = True) As Variant
  Dim objArrayList As Object
  Dim lngR As Long, lngC As Long
  
  On Error GoTo ErrExit
  
  Set objArrayList = CreateObject("System.Collections.Arraylist")
  
  With objArrayList
    For lngR = LBound(Field, 1) To UBound(Field, 1)
      For lngC = LBound(Field, 2) To UBound(Field, 2)
        If Not .Contains(Trim(Field(lngR, lngC))) Or Not Uniqe Then
          If Field(lngR, lngC) <> "" Then .Add Trim(Field(lngR, lngC))
        End If
      Next
    Next
    .Sort
    toArraySorted = .toArray
  End With
  
  Exit Function
  ErrExit:
  toArraySorted = -1
End Function


Gruß Sepp


 Bild

Beiträge aus den Excel-Beispielen zum Thema "Userform zur Dateneintragung"