Hallo Seeder oder Schumi,
Du solltest bei Deinen Fragen auch mal bekannt geben, wie Deine Datei aussieht (Zellenangaben). Dann könnte man etwas erstellen, was annähernd an Deine Dateistruktur herankommt.
Da diese Informationen fehlten, nachfolgend die Angaben meines Versuchsaufbaus:
A2 = Datum
B2 = Kennzeichen
C2 = Rückgabe SVERWEIS() Blatt "Tabelle2", Spalte 2
C3 = Rückgabe SVERWEIS() Blatt "Tabelle2", Spalte 3
D3 = Rückgabe SVERWEIS() Blatt "Tabelle2", Spalte 4
Kopiere die Makro in ein StandardModul und starte diese z.B. über eine Befehlsschaltfläche
Teste das Makro aber bitte in einer Testdatei und nicht gleich in Deiner Originaldatei.
Option Explicit
Sub Datumseingabe()
Dim varDate As Variant
Beginn:
'Eingabe Datum
varDate = InputBox("Bitte Datum eingeben.", "Datumseingabe...", Date)
'Wenn keine Datumseingabe erfolgt, Prozedur beenden
If varDate = "" Or varDate = False Then Exit Sub
'Wenn Datumseingabe nicht im Datumsformat, dann Meldung und zur _
Sprungmarke Beginn" springen
If Not IsDate(varDate) Then
MsgBox "Datumsangabe entspricht nicht einem Datumsformat. " _
& "Eingabe wiederholen", vbCritical, "falsche Datumseingabe..."
GoTo Beginn
End If
'Übergabe des Datums in Zelle A2
Range("A2") = varDate
End Sub
Sub Dateneingabe()
Dim strKennzeichen As Variant
Dim varRückgabe As Variant
Dim intMeldung As Integer
varRückgabe = ""
Range("B2").ClearContents
Beginn:
'Eingabe Datum
strKennzeichen = InputBox("Bitte Kennzeichne eingeben.", "Eingabe...", "Kennzeichen eintragen...")
'Wenn keine Datumseingabe erfolgt, Prozedur beenden
If strKennzeichen = "" Or strKennzeichen = False Then Exit Sub
On Error Resume Next
'Über SERWEIS suchen, ob Kennzeichen existiert
varRückgabe = Application.WorksheetFunction.VLookup(strKennzeichen, _
Sheets("Tabelle2").Range("A1:D" & _
Sheets("Tabelle2").Cells(Rows.Count, 1).End(xlUp).Row), 1, False)
On Error GoTo 0
If varRückgabe <> "" Then
'Wenn Kennzeichen vorhanden, dann Kennzeichen übertragen
Range("B2") = UCase(strKennzeichen)
Else
intMeldung = MsgBox("Das eingetragene Kennzeichen wurde nicht gefunden" & vbLf & vbLf _
& "Möchten Sie das Kennzeichen nun erfassen?", vbQuestion + vbYesNo, _
"Kennzeichen erfassen?")
'Wenn Nein betätigz, Prozedur beenden
If intMeldung = 7 Then Exit Sub
'Blatt "Tabelle2" aufrufen und Datenmaske öffnen
Sheets("Tabelle2").Activate
ActiveSheet.ShowDataForm
End If
End Sub
Beim Makro "Datumseingabe" wird die Eingabe auf einen korrekten Datumswert geprüft. Ist die Eingabe in Ordnung, wird das Datum in Zelle "A2" ausgegeben
Beim Makro "Dateneingabe" wird nach der Eingabe des Kennzeichen (Eingabe Groß- oder Kleinbuchstaben egal) über die "VLookup-Funktion" (SVEREWEIS() in VBA) geprüft, ob das Kennzeichen vorhanden ist. Wird ein Wert zurückgegeben, wird das Kennzeichen in Großbuchstaben in Zelle "B2" eingetragen.
Wird kein Wert zurückgegeben, erscheint eine Abfrage. Wird dort "Ja" betätgt, wird Tabellenblatt "Tabelle2" aufgerufen und die Datenmaske wird aufgerufen.
Wobei ich das mit der Kennzeicheneingabe und dem Neuanlegen des Kennzeichens anders regeln würde. Ich würde das über eine UserForm realisieren. Ich habe Dir mal eine Beispieldatei hochgeladen, in der ich das mal realisiert habe.
http://www.excelbeispiele.de/Beispiel_Supportnet/Beispiel_Seeder.xls
Du rufst die UserForm über den Button auf und trägst das Kennzeichen in der ComboBox ein oder wählst es aus vorhandenen aus. Bei der Eingabe siehst Du sofort, ob es das Kennzeichen bereits gibt, da die Daten autovervollständigt werden.
Bei Betätigen des Buttons werden die Daten (ohne SVERWEIS()) in das Tabellenblatt „Tabelle1“ übertragen. Gibt es den Datensatz noch nicht, so erscheint eine Abfrage. Wird dort „Ja“ betätigt, werden die Daten in „Tabelle2“ in die erste freie Zeile übertragen und die Daten werden ebenfalls in Blatt „Tabelle1“ in die Zeile 8 eingetragen.
In der Datei ist überigens auch das Beispiel mit obigen Makros realisiert. Schau Dir das einfach mal an.
MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]
