Timestamp en kopieren data

[Lampie173]

Beste allemaal,

In bijgevoegd voorbeeld staat omschreven wat de bedoeling is.

Het gaat over het (automatisch) uitlezen van de elektra meter om inzichtelijk te krijgen hoeveel stroom verbruikt/terug geleverd wordt.

Ik hoop dat duidelijk is omschreven.

Wie kan/wil mij helpen?

Groet,

 

[mvdvlist]

Misschien werkt dit.

In het doelblad heb ik de samengevoegde cellen verwijderd. Gaat nooit goed samen met VBA.

 

[Lampie173]

Hoi Opa Maarten,

Dank voor het bericht en de genomen moeite.

Nee, dat is niet wat de bedoeling is.

Het is de bedoeling dat de wijziging 'per regel' plaatst vindt.
Dus bij nieuwe meterstand op 1 mei wordt er op werkblad wijzigingen een nieuwe regel toegevoegd met de meterstand en timestamp
En dat dan 8 keer per dag.

Dat samengevoegde cellen een probleem kunnen zijn wist ik wel, maar ik dacht alleen als ze in de vba code 'betrokken' zijn.

 

[mvdvlist]

In principe moet dat ook gebeuren in deze versie. Maak maar eens handmatig een verandering in c3

 

[Lampie173]

Nee, er gebeurt helaas niets.

Wat ik ook verander in cel C3 op 'Blad 1' (Meter uitlezing)

 

[mvdvlist]

Vreemd. Werkt bij mij normaal.
Staat je macrobeveiliging aan? Macro`s moet je wel accepteren..

 

[Lampie173]

Nee, dit is niet precies wat ik zoek.

Iedere meterstand moet bewaard blijven, nu worden de wijzigingen steeds overschreven EN er staan een paar lege regels tussen.

 

[HSV]

Gaat dat invoeren handmatig of automatisch binnengehaald.

Als steeds cel C3 veranderd, wat doen 02/05 t/m 10/05/2023 in de tabel onder cel B3

 

[Lampie173]

Hoi HSV,

De invoer is (nog) handmatig.
De datums (01-05 t/m 10-05) waar u naar verwijst, staan vast in de kolom.
Als in blad 1 ('meter uitlezingen') de nieuwe meterstand wordt ingevuld (in C3) is het de bedoeling dat de 'oude' meterstand naar cel D3 in blad 2 ('wijzigingen') gekopieerd wordt.
Met bijbehorende 'Time' (u:mm:ss) in C3
De volgende meterstand (3 uur later) op blad 1 wordt dan overschreven, de oude stand wordt dan weer gekopieerd naar blad 2 in cel D4 met bijbehorende Time in C4
En zo dan nog 6 x die dag.
Dus regel voor regel wordt gekopieerd en staan onder elkaar.
Resultaat op blad 2 voor die dag (01-05)

Datum / time / nieuwe stand / teruglevering / saldering / opwekking / Verbruik
Datum / time / nieuwe stand / teruglevering / saldering / opwekking / Verbruik
Datum / time / nieuwe stand / teruglevering / saldering / opwekking / Verbruik
Datum / time / nieuwe stand / teruglevering / saldering / opwekking / Verbruik
Datum / time / nieuwe stand / teruglevering / saldering / opwekking / Verbruik
Datum / time / nieuwe stand / teruglevering / saldering / opwekking / Verbruik
Datum / time / nieuwe stand / teruglevering / saldering / opwekking / Verbruik
Datum / time / nieuwe stand / teruglevering / saldering / opwekking / Verbruik

Op 2-05 : Begint het weer van vooraf aan.

 

[HSV]

Het verhaal begreep ik wel.
Het ging mij om het idee waarom je 8 keer dezelfde cel gebruikt.

Test het maar eens.

 

[Lampie173]

Waarom 8 x dezelfde cel gebruiken: en in de andere cellen ernaast (D t/m G) de berekeningen kan maken middels formules
Ik wil op blad 1 een beetje het overzicht houden van begin- en eindstand

Op blad 2 kan ik zien hoeveel elektra in bepaalde tijdsdelen wordt gebruikt.
Gewoon uit nieuwsgierigheid. En eventueel waar is wat aan te passen (verschuiven) qua verbruik.

Toch nog even een vraag:

Ik snap niet veel van ListObjects, is de code nog op een eenvoudige manier te (her)schrijven?
Mijn kennis is niet zodanig dat ik dat (nog niet) snap.


Tevens het bestand wat ik wil gebruiken 'plat', zeg maar. ( zie voorbeeldbestand post #1)

 

[HSV]

Een Listobject voert de formules automatisch door als je een nieuwe rij invoert (veel handiger).

Maar goed: je wens.

Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, Range("c3:c1000")) Is Nothing Then
   With Target
     Sheets("wijzigingen").Cells(Rows.Count, 2).End(xlUp).Offset(1).Resize(, 7) = Array(Format(.Offset(, -1), "dd-mm-yyyy"), Format(Time, "h:mm:ss"), .Value, .Offset(, 1), .Offset(, 2), .Offset(, 3), .Offset(, 4))
   End With
 End If
End Sub

 

[Lampie173]

Hoi Harry,

Je code doet idd wat het moet doen!
Bedankt daarvoor.

Toch nog 2 vraagjes hierover:
Het stukje code hieronder
Array(Format(.Offset(, -1), "dd-mm-yyyy")
geeft als datum alleen steeds 01-05-1900 terug.

1. Hoe kan dit in de code naar de huidige datum omgezet worden en
2. Is het mogelijk om met een For..Next lus de cijfers 1 t/m 8 voor de (huidige) datum te plaatsen, zodat de volgende dag weer met een 1 begint daarna de 2e, tot aan 8.

Ik ben zelf met een For.. next de slag gegaan, dat werkt in zo verre dat ik bij 1 wijziging een reeks van 8 rijen in 1 te keer krijg, :shocked:

In ieder geval bedankt voor het lezen.

Groet,

 

[HSV]

Zet iets in blad Wijzigingen cel A2.

Private Sub Worksheet_Change(ByVal Target As Range)If Target.Count = 1 Then
 If Not Intersect(Target, Range("c3:c1000")) Is Nothing And Target <> "" Then
   With Target
     Sheets("wijzigingen").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 8) = Array((Sheets("wijzigingen").Cells(Rows.Count, 1).End(xlUp).Row - 2) Mod 8 + 1, Date, Format(Time, "h:mm:ss"), .Value, .Offset(, 1), .Offset(, 2), .Offset(, 3), .Offset(, 4))
   End With
 End If
End If
End Sub

 

[Lampie173]

Goedenavond Harry,


Dank voor je genomen moeite om mij te helpen.

Ik heb je (aangepaste) code overgenomen en wat getest.

Wat mij opviel was dat MOD bij de eerste set van 8 metingen met cijfer 0 begint en eindigt bij 8 (dus totaal 9 metingen)
Daarna worden wel gewoon de 8 metingen geteld. (wat de bedoeling is)

Dus zo:

0,1,2,3,4,5,6,7,8
1,2,3,4,5,6,7,8
1,2,3,4,5,6,7,8
enz.

Hoe kan is dit aan te passen?

Ik heb net e.e.a. over MOD gelezen op het internet, maar het is mij niet helemaal duidelijk.

 

[HSV]

Niet in het bestand wat je plaatste.

 

[Lampie173]

Hoi Harry,


Ik was even uit de roulatie, ben nu gelukkig weer hersteld!
Vandaar dat ik niet eerder kon reageren.

Ik heb de code als volgt:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRg As Range
On Error Resume Next
Set xRg = Intersect(Range("C92:C121"), Target)
If xRg Is Nothing Then Exit Sub
Range("S92").Value = Now()
 
 If Target.Count = 1 Then
 
 If Not Intersect(Target, Range("c3:c1000")) Is Nothing And Target <> "" Then
   With Target
   Sheets("wijzigingen").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 8) = Array((Sheets("wijzigingen").Cells(Rows.Count, 1).End(xlUp).Row - 2) Mod 8 + 1, Date, Format(Time, "h:mm:ss"), .Value, .Offset(, 1), .Offset(, 2), .Offset(, 3), .Offset(, 4))
 
   End With
 End If
 End If
End Sub

De 1e set van 8 uitlezingen laat de volgende cijferreeks zien (0,1,2,3,4,5,6,7 en 8) daarna doet de code wat het moet doen, dus een oplopende cijferreeks van 1 t/m 8 en zo verder.

Maar ik zie de 'fout' niet.
Wil jij hem eens testen waar het probleem zit?

Groet Toon.

 

[HSV]

Waar is het testmateriaal en waarom wordt er onnodige aan de code gesleuteld?

 

[Lampie173]

Hoi HSV,

Ik heb zelf getest en gevonden wat de fout is/was.

Het ging om de -2, zie hieronder:

Sheets("wijzigingen").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 8) = Array((Sheets("wijzigingen").Cells(Rows.Count, 1).End(xlUp).Row - [COLOR="#FF0000"]2[/COLOR]) Mod 8 + 1, Date, Format(Time, "h:mm:ss"), .Value, .Offset(, 1), .Offset(, 2), .Offset(, 3), .Offset(, 4))

Ik heb daar -1 van de gemaakt en nu gaat ie als een speer.

Waarom ik jouw oorspronkelijke versleuteld heb, is dat ik op het invoerblad wil kunnen zien wanneer/hoe laat er zich een wijziging heeft plaatsgevonden.

Dank voor je hulp.

 

[HSV]

Het is zo simpel als wat.
Dan begin je nu op rij 2 in je originele bestand weg te schrijven, en in het bestand wat je plaatste op rij 3.

Totaal overbodig is:

Dim xRg As Range
On Error Resume Next
Set xRg = Intersect(Range("C92:C121"), Target)
If xRg Is Nothing Then Exit Sub

Dus:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Count = 1 Then
   if Not Intersect(Target, Range("c3:c1000")) Is Nothing And Target <> "" Then
      Range("S92").Value = Now
   With Target
       Sheets("wijzigingen").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 8) = Array((Sheets("wijzigingen").Cells(Rows.Count, 1).End(xlUp).Row - 1) Mod 8 + 1, Date, Format(Time, "h:mm:ss"), .Value, .Offset(, 1), .Offset(, 2), .Offset(, 3), .Offset(, 4))
   End With
  End If
 End If
End Sub