Psst.. new poll here.
Psst.. new forums here.
Microsoft is blocking us again (TY IP Reputation!) so just use oauth login instead. :)
Paste
Pasted by JohnBoy ( 15 years ago )
' Sub für die Ausgabe
Private Sub ausgegeben_Click()
' Die unterste freie Zelle von Spalte E wird gesucht ...
Cells(65000, 5).End(xlUp).Offset(1, 0).Select
' ... und die eingegebene Schlüsselnummer wird dort eingegeben
Range(ActiveCell.Address) = Range("B3")
' Rechts daneben wird der zugehörige Name eingetragen.
ActiveCell.Offset(0, 1).Value = Range("D3")
' Und noch in die Zeile nochmal rechts daneben wird ein Timestamp eingefuegt.
ActiveCell.Offset(0, 2).NumberFormat = "dd mmm yyyy hh:mm:ss"
ActiveCell.Offset(0, 2).Value = Now
' Es wird nach der Schluesselnummer in Spalte E gesucht um diese ggf. dort zu entfernen.
Dim rwindex As Long
For rwindex = 40 To Cells(65356, 2).End(xlUp).Row
If Cells(rwindex, 2).Value = Range("B3").Value Then
Cells(rwindex, 2).Value = ""
Cells(rwindex, 2).Offset(0, 1).Value = ""
Exit For
End If
Next rwindex
' Anschließed werden von der ermittelt Position bis zu Zeile 500 alle IDs um Timestamps um eine Position nach oben geschoben, um die entstandene Luecke aufzufuellen.
Dim replace_index As Long
For replace_index = rwindex To 500
Cells(replace_index, 2).Value = Cells(replace_index + 1, 2)
Cells(replace_index, 2).Offset(0, 1).Value = Cells(replace_index + 1, 2).Offset(0, 1)
Next replace_index
' Schließlich werden die Eingabefelder geleert.
Range("B3").Value = ""
Range("D3").Value = ""
End Sub
' Sub für das Löschen aus dem Schrank
Private Sub ausSchrankLoeschen_Click()
' Es wird nach der Schluesselnummer in Spalte E gesucht um diese dort zu entfernen ...
Dim rwindex As Long
For rwindex = 17 To Cells(65356, 2).End(xlUp).Row
If Cells(rwindex, 2).Value = Range("I3").Value Then
Cells(rwindex, 2).Value = ""
Exit For
End If
Next rwindex
' Anschließed werden von der ermittelt Position bis zu Zeile 500 alle IDs um Timestamps um eine Position nach oben geschoben, um die entstandene Luecke aufzufuellen.
Dim replace_index As Long
For replace_index = rwindex To 500
Cells(replace_index, 2).Value = Cells(replace_index + 1, 2)
Cells(replace_index, 2).Offset(0, 1).Value = Cells(replace_index + 1, 2).Offset(0, 1)
Next replace_index
End Sub
Revise this Paste