|
Falls VBA dann so
- Rechtsclick auf den Tabellenblattreiter
- Code anzeigen
- Rechts den Code reinkopieren
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fehler
Const APPNAME = "Worksheet_Change"
Dim RNG1 As Range, RNG2 As Range
Dim Hist As Integer, Anz As Integer, LR As Long
Dim T1 As String, Neu As String
Set RNG1 = Range("B1") ' zu überwachende Zelle mit dem Vorgabewert
Set RNG2 = Range("B4") ' Zielzelle für den QR
Hist = 8 'Spalte für die Historie
LR = Cells(Rows.Count, Hist).End(xlUp).Row 'letzte Zeile der Spalte
If Not Intersect(RNG1, Target) Is Nothing Then
If Target.Count = 1 Then
T1 = Target & "-" & Format(Date, "YY")
Anz = WorksheetFunction.CountIf(Columns(Hist), T1 & "*")
Neu = T1 & Format(Anz + 1, "000")
Application.EnableEvents = False
Cells(LR + 1, Hist) = Neu
RNG2 = Neu
Application.EnableEvents = True
End If
End If
'*** Fehlerbehandlung
Err.Clear
Fehler:
Application.EnableEvents = True
If Err.Number <> 0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _
& "Fehlernummer: " & Err.Number & vbLf & Err.Description: Err.Clear
End Sub
Ich bin dabei von folgendem Ausgegangen:
- Dein Vorgabewert wird in B1 eingetragen.
- Die Histoniendaten werten in Spalte H untereinander fortgeschrieben
- Der QR Code wird zusätzlich in B4 angezeigt
Wenn du nun in B1 den Wert bearbeitets, wird entsprechend deiner Vorgabe hochgezählt
LG UweD
|