Hallo Melbux,
der neue Wert soll doch in die nächste freie Spalte und nicht Zeile geschrieben werden, oder? Warum soll das 4 mal geschehen (for I=0 to 3)?.
Ich habe dein Makro geringfügig modifiziert, weiß aber nicht, ob ich dein Ziel richtig verstanden habe:
Sub Mitarbeiter_eingeben_suchen()
Dim Suchbegriff As String, Ergebnis As Range, Msg As Long
Dim NeueZeile As Long
'InputBox in der man die Kundennummer eingibt.
Suchbegriff = InputBox("Bitte geben sie den Nachnamen ein")
' ggf. abbrechen
If Len(Trim(Suchbegriff)) = 0 Then Exit Sub
'Durchsucht den angegebenen Bereich nach der Nachnamen
With Sheets(1)
Set Ergebnis = .Range("B9:C" & .Range("B65536").End(xlUp).Row).Find(What:=Suchbegriff, LookIn:=xlValues, LookAt:=xlWhole)
End With
'Gibt entweder "Nichts gefunden" oder die entsprechenen Werte raus
If Ergebnis Is Nothing Then
MsgBox "Nichts gefunden", vbOKOnly, "Mitteilung"
Exit Sub
End If
Msg = MsgBox("Folgender Eintrag wurde gefunden " & vbCr & _
"Name: " & vbTab & Ergebnis.Offset(0, 0).Text & vbCr & _
"Vorname: " & vbTab & vbTab & Ergebnis.Offset(0, 1).Text & vbCr & _
"Stundenzahl: " & vbTab & Ergebnis.Offset(0, 2).Text & vbCr & _
"Wollen Sie diesen Eintrag eintragen?", vbQuestion + vbYesNoCancel, "Einfügen")
With Sheets(2)
Stundenzahl = Ergebnis.Offset(0, 2).Text
If Msg = vbYes Then
'Dim i As Integer
'For i = 0 To 3 'Warum 4 mal???
Set Ergebnis = .Range("B8:C" & .Range("B65536").End(xlUp).Row).Find(What:=Suchbegriff, LookIn:=xlValues, LookAt:=xlWhole)
a = Ergebnis.Row
'------ hier fehlt jetzt das, wo festgelegt wird, wo die Ergebnisse eingetragen werden sollen---------
'Das hier ist mein Ende das nicht funktioniert...
'Sucht die letzte freie Zelle in der Zeile und schreibt jeweils in die Spalten den Wert
.Cells(Ergebnis.Row, .Range(Cells(Ergebnis.Row, 1).Address).End(xlToRight).Column + 1) = Stundenzahl
'Next
End If
End With
End Sub
Gruß
Holger
Melbux schrieb am 28.05.2008 09:24:25:
hey,
also ich habe eine Tabelle mit Namen und Stundenanzahl. Ich muss nun einen Namen aus der Tabelle suchen, den Namen dann in einer 2. Tabelle auf dem 2. Arbeitsblatt suchen und dort die Stundenzahl eintragen lassen. Wenn dort bereits eine Zahl steht soll er die Zahl eine Zelle weiter rechts einfügen. Mein Problem liegt darin, dass er den Namen und die Stundenzahl zwar findet die Stundenzahl allerdings nicht einträgt. Hier ist der Anfang:
Sub Mitarbeiter_eingeben_suchen()
Dim Suchbegriff As String, Ergebnis As Range, Msg As Long
Dim NeueZeile As Long
'InputBox in der man die Kundennummer eingibt.
Suchbegriff = InputBox("Bitte geben sie den Nachnamen ein")
' ggf. abbrechen
If Len(Trim(Suchbegriff)) = 0 Then Exit Sub
'Durchsucht den angegebenen Bereich nach der Nachnamen
With Sheets(1)
Set Ergebnis = .Range("B9:C" & .Range("B65536").End(xlUp).Row).Find(What:=Suchbegriff, LookIn:=xlValues, LookAt:=xlWhole)
End With
'Gibt entweder "Nichts gefunden" oder die entsprechenen Werte raus
If Ergebnis Is Nothing Then
MsgBox "Nichts gefunden", vbOKOnly, "Mitteilung"
Exit Sub
End If
Msg = MsgBox("Folgender Eintrag wurde gefunden " & vbCr & _
"Name: " & vbTab & Ergebnis.Offset(0, 0).Text & vbCr & _
"Vorname: " & vbTab & vbTab & Ergebnis.Offset(0, 1).Text & vbCr & _
"Stundenzahl: " & vbTab & Ergebnis.Offset(0, 2).Text & vbCr & _
"Wollen Sie diesen Eintrag eintragen?", vbQuestion + vbYesNoCancel, "Einfügen")
If Msg = vbYes Then
Dim i As Integer
For i = 0 To 3
With Sheets(2)
Set Ergebnis = .Range("B8:C" & .Range("B65536").End(xlUp).Row).Find(What:=Suchbegriff, LookIn:=xlValues, LookAt:=xlWhole)
End With
------ hier fehlt jetzt das, wo festgelegt wird, wo die Ergebnisse eingetragen werden sollen---------
Das hier ist mein Ende das nicht funktioniert...
'Sucht die letzte freie Zeile und schreibt jeweils in die Spalten den Wert
NeueZeile = Sheets(2).Range("b65336").End(xlUp).Offset(1, 0).Row
Sheets(2).Range("d" & NeueZeile) = Stundenzahl
Next
End If
End Sub
Würd mich freuen wenn mir jemand weiterhelfen kann!
|