AW: mit Doppelklick
20.05.2021 08:26:06
hary
Moin Nico
Es wird in Spalte A die Bezeichnung HEA* gesucht
Ja, wobei das Sternchen der Platzhalter ist. Also HEA ist ein muss, gefolgt von irgendetwas z.B. HEA xxx
Beim untenstehenden Code ist es der Blattname (Sh.Name). Du schreibst ja: "Heißen würden die z.B. HEB, HEM usw."
SearchDirection:=xlPrevious
xlPrevious sucht von unten nach oben. ab Cells(ActiveCell.Row, 1)
Dieser Code gehoert in den Code DieseArbeitsmappe. Er wirkt bei allen Blaetter ausser: "Schrottliste" und "Vorgaben"
So brauchst du nicht fuer jedes Blatt einen eigenen Code.
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim lngLetzeZeile As Long, Bezeichnung As Long
Dim Zelle As Range
If Sh.Name "Schrottliste" And Sh.Name "Vorgaben" Then '--wenn Blattname nicht Schrottliste oder Vorgaben
If Target = "Ausbuchen!" Or Target = "Ticket Rest!" Then '-- ausfuehren wenn Zellinhalt: Ausbuchen oder Ticket
Application.ScreenUpdating = False
Cancel = True
Sh.Unprotect
Set Zelle = [A:A].Find(What:=Sh.Name & "*", After:=Cells(ActiveCell.Row, 1), LookIn:=xlFormulas, SearchDirection:=xlPrevious)
If Not Zelle Is Nothing Then
Bezeichnung = Zelle.Row
If Target = "Ausbuchen!" Then '--loescht und uebertraegt nur bei Ausbuchen!
With Worksheets("Schrottliste")
lngLetzeZeile = .Cells(Rows.Count, 1).End(xlUp).Row
.Cells(lngLetzeZeile + 1, 1) = Cells(Bezeichnung, 1).Value '--z.B. HEA XX
.Cells(lngLetzeZeile + 1, 2) = Cells(Bezeichnung, 1).Offset(8, 0) '--die lange Nummer in SpaltA
.Cells(lngLetzeZeile + 1, 3) = Cells(Target.Row, 1) '--die Charge aus SpalteA
.Cells(lngLetzeZeile + 1, 4) = Cells(Target.Row, 3) '--Stueck
.Cells(lngLetzeZeile + 1, 5) = Cells(Target.Row, 4) '--Rest
.Cells(lngLetzeZeile + 1, 6) = CDate(Format(Now, "dd.mm.yyyy hh:mm")) '--setzt Datum Schrottliste
End With
Application.EnableEvents = False
Range(Cells(Target.Row, 1), Cells(Target.Row, 3)).ClearContents '--Loescht
Range(Cells(Target.Row, 5), Cells(Target.Row, 7)).ClearContents
Range(Cells(Target.Row, 11), Cells(Target.Row, 20)).ClearContents
ElseIf Target = "Ticket Rest!" Then '--loescht nicht bei Ticket Rest!
Cells(1000, 3) = Cells(Bezeichnung, 1) '-- Bez. nach C1000
Cells(1001, 3) = Cells(Target.Row, 1) '--die Charge nach C1001
Cells(1002, 3) = Cells(Target.Row, 2) '--die Laenge nach C1002
End If
End If
End If
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
Sh.Protect
End Sub
gruss hary
