Mutaties in een cel

[Siard123]

Hallo,
Is het mogelijk om een overzicht te krijgen/maken van de mutaties die een cel ondergaat in hoeveelheden?
Dit zou ik graag willen weten zodat de werkvoorbereider in het systeem kan melden hoeveel een afdeling tot dusver geproduceerd heeft.

Siard

 

[popipipo]

Na 42 keer bekeken te zijn en nog geen reactie wordt het tijd om een voorbeeld xls bestandje te plaatsen.

 

[Siard123]

Hierbij het voorbeeld bestand: Bekijk bijlage Opdrachten spuiterij (2).xls

In de kolom 'aantal afgeleverd' voert iemand in hoeveel er gereed zijn. En dat gaat vaak in delen. Nu wil ik graag weten hoeveel die cel elke keer veranderd.

Hoop zo voldoende uitleg te hebben gegeven.

 

[pixcel]

De gebruikelijke methode is om de afzonderlijke mutaties in een aparte tabel vast te leggen, en een draaitabel te gebruiken.
Als basisidee: maak eens een tabel met drie kolommen: Datum, Ordernr, Aantal (+/-). En laat daar eens een draaitabel op los.

 

[HSV]

Is dit wat je zoekt?

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column = 13 Then
 If Target.Offset(, 1) = "" Then
   Target.Offset(, 1) = Target
    Else
   Target.Offset(, 1) = Target.Offset(, 1) & "+" & Target - Application.Evaluate("=" & Target.Offset(, 1))
  End If
If Target <> "" And Target.Value = Target.Offset(, -8).Value Then
   Set r = Sheets("Archief").Cells(Rows.Count, 1).End(xlUp)
     r.Offset(1).Resize(1, 14) = Range("A" & Target.Row).Resize(1, 14).Value
     Target.EntireRow.Delete xlUp
   End If
  End If
Application.EnableEvents = True
End Sub

 

[Siard123]

@ HSV - Dit is inderdaad wat ik zoek. Heel mooi. Is het ook mogelijk om de datum erachter te zetten? Omdat de mutaties in meerdere stappen gedaan worden moet de persoon die het verder in het systeem wil zetten alles bij langs of het veranderd is. Als er tot slot nog een datum achterstaat wanneer de cel is aangepast hoeft hij niet alles te controleren.

 

[HSV]

Het rode gedeelte is de verandering in de code.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column = 13 Then
 If Target.Offset(, 1) = "" Then
  [COLOR=#ff0000] Target.Offset(, 1).Resize(, 2) = Array(Target, Now)
[/COLOR]    Else
   [COLOR=#ff0000]Target.Offset(, 1).Resize(, 2) = Array(Target.Offset(, 1) & "+" & Target - Application.Evaluate("=" & Target.Offset(, 1)), Now)
[/COLOR]  End If
If Target <> "" And Target.Value = Target.Offset(, -8).Value Then
   Set r = Sheets("Archief").Cells(Rows.Count, 1).End(xlUp)
     r.Offset(1).Resize(1, [COLOR="#FF0000"]15[/COLOR]) = Range("A" & Target.Row).Resize(1, [COLOR="#FF0000"]15[/COLOR]).Value
     Target.EntireRow.Delete xlUp
   End If
  End If
Application.EnableEvents = True
End Sub

 

[Siard123]

Werkt perfect!