Excel VBA Spaltensuche, Weitersuche, Werte
08.12.2017 14:38:14
Jehona
ich als VBA Frischling stehe vor folgendem Problem:
Der Wert (Nachname) einer TextBox wird in der Spalte einer 2. Excel-Tabelle gesucht(funktioniert schon mal). Anschließend, wenn der Nachname gefunden wurde, soll in der gleichen Zeile, jedoch in der 4. Spalte, die aktuelle Uhrzeit eingetragen werden. (funktioniert ebenfalls).
Nun kann es vorkommen, dass ein Nachname zwei Mal existiert. In diesem Fall soll er, sofern bereits ein Wert in Spalte 4 vorhanden ist, nach der nächsten Zeile suchen, die den Nachnamen enthält. Hier soll er dann den Wert in Spalte 4 eintragen (sofern noch kein Wert vorhanden ist).
Hier mein VBA-"Code":
Private Sub CommandButton1_Click()
Private Sub UserForm_Initialize()
TextBox2.Value = Time
End Sub
Dim rng As Range
Workbooks.Open ("H:\Eigene Dateien\Daten\Besuchermanagement\Datenbank_Besucher.xlsx") ' MappenName ist String!, gleiche Verz. wie Mappe!
With ActiveWorkbook.Worksheets("Besucher") ' Blattname ist String!
'Spalte B nach wert durchsuchen
Set rng = Sheets("Besucher").Range("B:B").Find(what:=TextBox1.Text, Lookat:=xlWhole, LookIn:=xlValues)
'Wenn wert entdeckt
If Not rng Is Nothing Then
lngZeile = rng.Row
ActiveSheet.Cells(lngZeile, 4).Value = TextBox2.Value
MsgBox "Sie wurden erfolgreich eingecheckt. Bitte lassen Sie sich eine Warnweste und eine Ausweisnummer geben.", , "Check-in"
Else
MsgBox "Wir konnten keinen Eintrag finden. Bitte registrieren Sie sich.", , "Check-in fehlgeschlagen"
End If
If ActiveSheet.Cells(lngZeile, 4).Value "" Then
Do
Set rng = .FindNext(rng)
Loop While Not rng Is Nothing And ActiveSheet.Cells(lngZeile, 4).Value = ""
Unload Me
End If
End With
ActiveWorkbook.Close savechanges:=True ' Schliessen mit Sichern
Application.ScreenUpdating = True ' Aktualisierung ein
Set outObj = Nothing
Unload UserForm3
End Sub
Lieben Gruß