Excel Eingabemaske zum Datenbank erstellen
Hallo, vielleicht kann mir jemand von euch helfen. Ich möchte für meinen Job eine Exceltabelle erstellen und zwar soll die Folgendes beinhalten.
Auf dem ersten Tabellenblatt sollen die Daten erfasst werden und die Daten sollen automatisch nach der Eingabe auf dem zweiten Tabellenblatt abgespeichert werden.
BSP: Siehe Bilder im Anhang
Ich hoffe jemand kann mir dabei helfen und mir Tipps geben.
3 Antworten
Ich hab mich da nochmals reinvertieft (unvertretbar lange, denn da hat mich ein Problem gefuchst...)
Jedenfalls habe ich Deine Vorgaben arg modifiziert, schau Dir das im Screenshot an. Grund:
Die Eingabe startet, sobald die letzte der 3 gelben Zellen im Blatt Maske ausgefüllt wird. Deshalb sind die anderen, optional zu füllenden Spalten links davon angeordnet. Die Zelle Zeit/Teil wird automatisch in Minuten berechnet (mit Dezimalkommastellen)
Die Datenbank (Blatt Dbk) muss dieselbe Anordnung haben, man kann rechts davon dann noch Kommentare und Auswertungen dranhängen.
Eigentlich wollte ich noch eine Schnelleingabe ohne Doppelpunkt ermöglichen, aber die funktionierende Formel streikt bei der Umwandlung zum Makro, da müsste noch eine Umformatierung der Zelle mit rein, hab ich aber jetzt weder Muße noch übrige Zeit (will seit Tagen noch ein anderes µ bearbeiten und komm nicht dazu). Also hier das µ:
(gehört ins Modul des Blatts Maske. Ich hoffe, der Rest ist selbsterklärend)
Sub worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D5:F5").Cells) Is Nothing Then
'hier sollte eine Umwandlungsformel für Kurzeingabe rein (s.Ende):
If Application.CountA(Range("D5:F5")) = 3 Then
Range("G5").Value = Range("E5").Value / Range("F5").Value * 24 * 60
If IsEmpty(Range("A5")) Then Range("A5").Value = Date
Range("A5:G5").Copy
Worksheets("Dbk").Cells(Worksheets("Dbk").Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial (xlValues)
'zeigt, im Blatt Maske, was eingetragen wurde
Worksheets("Maske").Cells(8, 1).PasteSpecial (xlValues)
'leert neue Eingabezeile, damit aufnahmbereit für nächsten Eintrag
Worksheets("Maske").Range("A5:G5").ClearContents
End If
'hier evtl noch Zuletzt-Eingabe-Korrekturmöglichkeit einbauen (Tippfehler!)(alle anderen Zellen sperren?)
End If
End Sub
'Umwandlung einer Kurz-Eingabe in E5 als 11722 anstatt 1:17:22
'If Target.Address = "E5" Then If Target.Value >= 100 Then Target.Value = Right(Left("000" & Target.Value, Len("000" & Target.Value) - 4) & ":" & Left(Right("0" & Target.Value, 4), 2) & ":" & Right(Target.Value, 2), 8) + 0
'entspr. der Formel: =RECHTS(LINKS("000"&E5;LÄNGE("000"&E5)-4)&":"&LINKS(RECHTS("0"&E5;4);2)&":"&RECHTS(E5;2);8)+0 (geht als Formel, scheitert in selber Zelle als µ noch an Formatumwandlungsproblemen: 11722 liefert 281328:00:00
ich hab noch vor, ein Makro für die Korrektur der letzten Eingabe zu erstellen, damit das Blatt Dbk ausgeblendet werden kann (Datenschutz!) und ggf. alle Zellen ausser den Eingabe- und Korrekturzellen gesperrt werden können, ebenfalls wg des Datenschutzes.
eigentlich müsstest du ja noch viel mehr erfassen (welcher MA hat da gearbeitet, an welcher Maschine, in welcher Schicht, vllt nach wieviel Pause, mit wie geeignetem Material (Zustand des Werkzeugs) etc. Oder macht REFA das ganz primitiv?
(hatte nie damit zu tun, weiß nur, dass dem Stachanow viele Leute zugearbeitet hatten wie bei einem Hochleistungssportler zum Rekord erstellen).
Schaue, dass nur die aktuelle Arbeitsmappe geöffnet ist! Kontrolliere, dass die Tabellenblätter Tabelle1 und Tabelle2 heissen, an sonst dies in der Formel geändert werden muss. Gehe nun ins Menü Entwicklertools und anschliessend auf Visual Basic. Im der neuen Auswahl klickst Du auf Einfügen und anschliessend auf Modul. Nun öffnest Du das Module eins mit Doppelklick (Siehe Grafik - Schritt 1). Anschliessend kopierst Du nachstehende Formel 1:1 ins weisse Arbeitsfeld. Du erhältst nun die gleiche Ansicht wie in der Grafik.
Sub Zeile_Tabelle1()
'Bereich Tabelle1
Sheets("Tabelle1").Range("A5:E5").Copy
'einfügen in erste freie Zeile in ausgabe
Sheets("Tabelle2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
'Kopiermodus beenden
Application.CutCopyMode = False
End Sub
Nun speicherst Du Die Arbeitsmappe unter dem Dateityp Excel Arbeitsmappe mit Makros ab und fertig ist Deine Arbeitsmappe
Viel Erfolg
Danke schon mal für die Hilfe im voraus. Ich bin schon begeistert! Ich werde es ausprobieren sobald ich zu Haus bin.
Die Reihenfolge der Spaltennamen ist egal. Die Teilenummer könnte sich wiederholen, falls eine Zeit aufgenommen wurde, die stark von der alten Zeit abweicht. Das Datum sollte sich idealerweise immer automatisch eintragen. Also das von heute. Der Datensatz soll auch nur übernommen werden, wenn der vollständig ist und die Einträge können ruhig normal auf der zweiten Seite untereinander abgespeichert werden.
Das ist zwar ein richtiger Ansatz, aber das Makro muss manuell gestartet werden und ist hier auf A5:E5 festgelegt..Das soll aber sicher ständig erweitert werden. Ausserdem weiß ich nicht, pob die adressfindung so funktioniert.
Tipp: mach ein Eorksheet_Change() draus im Code von Tabelle1, dann sollte es bei jedem Neueintrag/Ändering den Wert (und vorzugsweise an dieselbe stelle) übernehmen.
Vllt schaffst Du es selbst, ich schau heut nacht nochmal hier rein.
noch was zur Klärung: Soll der Datensatz erst übernommen werden, wenn er vollständig ist? (wäre vermutlich am wenigsten anfällig gegen Fehler zu machen)
Im nachhinein würde aber jede Korrektur einen weiteren Datensatz erzeugen, es sei denn, Teilenummer wäre einmalig.
Das muss man beides wissen.
Das Datum könnte man leer lassen, dann bestünde die Möglichkeit, das heutige Datum automatisch einzutragen (if isempty(....) then ...Date. Ansonsten dürfte man das Datum nicht zuletzt eintragen: Datumsspalte als zweite?
Tipp: Das geht mit einem VBA-Makro (Worksheet_Change). Wenn du kein VBA kannst, vielleicht ein Kollege?
Gruß, Max.
Weiss nicht, ob du je nochmal hier reinschaust, aber ich füge es der Vollständigkeit halber hinzu:
Hab jetzt auch eine Kurzeingabe programmieren können (und viel dabei gelernt, aber auch viel Frust erlebt). Ist vllt zu umständlich, hab aber keinen Nerv mehr, das zu optimieren, es geht jedenfalls bei mir.
Kurzeingabe heisst, dass man in E5 wahlweise auch zB 123456 anstatt 12:34:56 eingeben kann. Die Kurzeingabe hat einen engeren Auswerterahmen von 23:59:59=235959 bis herab zu 5 = 00:00:05 (das sind 5 sec, führende Nullen sind nicht nötig), während man bei Zeiteingabe von 99:59:59 .. 0:00:01 gehen könnte.(die Einschränkung ist einerseits der Variablen umgewandelt As Date, andererseits der Abgrenzung, denn 99:00:00 ist <4,2 Tage, und das ist möglicherweise häufiger als der Zeitbereich <5s :
Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D5:F5")) Is Nothing Then
Debug.Print Target.Address 'ok: $E$5
If Target.Address = "$E$5" Then
If Target.Value >= 4.2 Then
Debug.Print Target.Value 'ok: 235959
Dim Eingabe As String, umgewandelt As Date 'As Date toleriert (hier?) max 23:59:59
Eingabe = CStr(Target.Value)
Debug.Print Eingabe 'ok: 235959
umgewandelt = Right(Left("00000" & Eingabe, Len("00000" & Eingabe) - 4) & ":" & Left(Right("000" & Eingabe, 4), 2) & ":" & Right(Eingabe, 2), 8)
Debug.Print umgewandelt 'ok: 23:59:59
Target.Value = umgewandelt
Debug.Print Target.Value
End If
Debug.Print "gefüllte Zellen in D5:F5: " & Application.CountA(Range("D5:F5"))
'nur wenn alle drei gelben Zellen gefüllt:
If Application.CountA(Range("D5:F5")) = 3 Then
'wird Zeit/Stück ausgerechnet als x,y Minuten/Stück also Dezimalzahl für Minuten
Debug.Print Range("E5").Value / Range("F5").Value * 24 * 60 ' ok: 0,999988425925926 oder 107,847619047619
Range("G5").Value = Range("E5").Value / Range("F5").Value * 24 * 60
'ggf fehlendes Datum als heute() eingetragen
If IsEmpty(Range("A5")) Then Range("A5").Value = Date '<== einzeilige Var.
Range("A5:G5").Copy
'Kopie nach Dbk!An:Gn5 als Werte
Worksheets("Dbk").Cells(Worksheets("Dbk").Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial (xlValues)
'zeigt zusätzlich im Blatt Maske, was zuletzt eingetragen wurde (so dass im Blickfeld):
Worksheets("Maske").Cells(8, 1).PasteSpecial (xlValues)
'leert neue Eingabezeile, damit aufnahmbereit für nächsten Eintrag
Worksheets("Maske").Range("A5:G5").ClearContents
End If
End If
End If
'hier evtl noch Zuletzt-Eingabe-Korrekturmöglichkeit einbauen (Tippfehler!)
' Korrekturen in Zeile 8 in und neben den grünen Zellen. Anzeige der Korrekturen in Zeile 5. (alle anderen Zellen sperren?)
If Not Intersect(Target, Range("A8:G8")) Is Nothing Then Exit Sub 'derzeit, weil Korrektur noch nicht ausgearbeitet
'... vllt korr. Teilezahl darunter anzeigen? bei Korrektur keine Kurzeingabe in E8 nötig
End Sub
Die Korrektur hab ich (noch?) nicht erstellt, stelle ich auch ohne Nachfrage nicht mehr hier rein.(ich sehe das nur, wenn Du den Kommentar bewertest, in den Neuigkeiten, sonst nicht)