• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Van minuut naar uurwaardes Deel 2

Status
Niet open voor verdere reacties.
De andere opties ook al bekeken. Je reageert wel heel erg selectief.
 
zo ?
Kolom N mag straks weg.

Zie ook VenA, ik denk dat de PQ-specialisten (=niet ik) hier nog handiger oplossingen kunnen op verzinnen.
 

Bijlagen

  • Minuut naar uur (AC) (version 1).xlsb
    1,1 MB · Weergaven: 11
Laatst bewerkt:
Volgende versie.
Ik ben niet ontevreden over de snelheid.
Er hoeven in het werkboek ook geen aanpassingen gedaan te worden.

Code:
Sub M_snb()
    c00 = "yyyymmdd hh.00"
    sn = Blad4.Cells(1).CurrentRegion
    
    y = DateDiff("h", sn(2, 1), sn(UBound(sn), 1))
    With CreateObject("scripting.dictionary")
       For j = 2 To y + 2
          c01 = Format(sn(2, 1) + (j - 2) / 24, c00)
          .Item(c01) = Array(0, 0)
       Next
       
       For j = 2 To UBound(sn)
          c01 = Format(sn(j, 1), c00)
          sp = .Item(c01)
          .Item(c01) = Array(sp(0) + sn(j, 2), sp(1) + 1)
       Next
       
       ReDim st(.Count, 1)
       st(0, 0) = "Time"
       st(0, 1) = "Average"
       For Each it In .keys
          n = n + 1
          sp = .Item(it)
          st(n, 0) = it
          If sp(0) > 0 And sp(1) > 0 Then st(n, 1) = sp(0) / sp(1)
       Next
     End With
       
    Blad4.Cells(1, 6).Resize(UBound(st) + 1, 2) = st
End Sub
 

Bijlagen

  • __urenoverzicht_snb.xlsb
    1 MB · Weergaven: 12
Laatst bewerkt:
@snb
Laatste toevoeging is als ik van meerdere kolommen het uur gemiddelde zou willen, ik dacht dat ik het vanwege de snelheid en grootte van de database moest verdelen over meerdere excel sheets, maar nu ik de snelheid zie, kan dat makkelijk in één bestand. Er zijn namelijk veel meer kolommen die ik wil middelen en met mijn methode stond ie makkelijk 5 minuten te rekenen, en dan was dat nog maar data vanaf december vorig jaar. Uiteindelijk gaat elke sensor 5 jaar onafgebroken draaien.
In het nieuwe bestand slechts 3 kolommen, maar als ik zie hoe dat werkt kan ik de rest wel zelf toevoegen.
 

Bijlagen

  • urenoverzicht_3_kolommen.xlsb
    1,2 MB · Weergaven: 10
Laatst bewerkt:
Aangezien jij net als ik niets van VBA begrijpt, gebruik ik maar een paar klikjes om een draaitabel te maken. Blijkbaar is dat zelfs te lastig of om er iig op te reageren.
 

Bijlagen

  • urenoverzicht_3_kolommen.xlsb
    487,1 KB · Weergaven: 10
Laatst bewerkt:
@snb, inderdaad, heel snel en verklaarbaar, ik deed 100.000 delingen om het gemiddelde te berekenen, terwijl er maar 2.000 relevant zijn.
Mooie oplossing.
Dat wordt straks nog mooier, als er ook nog de volgende parameters in je sp stopt.

Die draaitabel van VenA is ook goed, misschien iets logger, als je er straks mee verder gaat werken.
Bepaalde items moeten nog beter verborgen worden.

Maar ik ben nog steeds van overtuigd, dat je je gegevens via PQ zou moeten inlezen en verwerken, veel beter dan die omweg met een csv-file.
Alleen hoe krijg je die gegevens, dat is niet te zien op die website.

Aangezien jij net als ik niets van VBA begrijp ...
:thumb:
 
Laatst bewerkt:
Voor 3 meetinstrumenten:

Code:
Sub M_snb()
    c00 = "yyyy/mm/dd hh:00"
    sn = Blad4.Cells(1).CurrentRegion
    
    y = DateDiff("h", sn(2, 1), sn(UBound(sn), 1))
    With CreateObject("scripting.dictionary")
       For j = 2 To y + 2
          c01 = Format(sn(2, 1) + (j - 2) / 24, c00)
          .Item(c01) = Array(0, 0, 0, 0, 0, 0)
       Next
       
       For j = 2 To UBound(sn)
          c01 = Format(sn(j, 1), c00)
          sp = .Item(c01)
          .Item(c01) = Array(sp(0) + sn(j, 2), sp(1) + 1, sp(2) + sn(j, 3), sp(3) + 1, sp(4) + sn(j, 4), sp(5) + 1)
       Next
       
       ReDim st(.Count, 3)
       st(0, 0) = "Time"
       st(0, 1) = "Average" & sn(1, 2)
       st(0, 2) = "Average " & sn(1, 3)
       st(0, 3) = "Average " & sn(1, 4)
       
       For Each it In .keys
          n = n + 1
          sp = .Item(it)
          st(n, 0) = it
          If sp(1) > 0 Then st(n, 1) = sp(0) / sp(1)
          If sp(3) > 0 Then st(n, 2) = sp(0) / sp(3)
          If sp(5) > 0 Then st(n, 3) = sp(0) / sp(5)
       Next
     End With
       
    Blad4.Cells(1, 10).Resize(UBound(st) + 1, UBound(st, 2) + 1) = st
End Sub

Maar ik dacht dat die 3 meetinytrumenten juist op verschillende tijdstippen wel/geen metingen registreerden ?
 
Laatst bewerkt:
Die twee kolommen die erbij komen is data van 1 fijnstof meter. Eén meter meet meer dan alleen fijnstof. Er wordt ook luchtvochtigheid, luchtdruk en temperatuur gemeten. Zo ook de signaalsterkte van de data verbindingen, gps coördinaten en nog een flink aantal andere parameters die in de online csv komen. In totaal zijn het er 24 per minuut, maar niet allemaal moeten gemiddeld worden. We hebben toestemming gekregen om een aantal sensoren bij officiële meetstations te hangen om de kwaliteit en bijvoorbeeld ook drift van onze sensoren te monitoren. De officiële metingen genereren uurgemiddeldes, dus vandaar dat ik van minuut naar uurwaardes wil om te kunnen vergelijken en eventueel tot een kalibratie factor te komen.
 
OK. dan doet de code wat je vroeg.
 
Ik heb hem al gevonden:
Was dit:
Code:
If sp(1) > 0 Then st(n, 1) = sp(0) / sp(1)
If sp(3) > 0 Then st(n, 2) = sp(0) / sp(3)
If sp(5) > 0 Then st(n, 3) = sp(0) / sp(5)

Is nu dit:
Code:
If sp(1) > 0 Then st(n, 1) = sp(0) / sp(1)
If sp(3) > 0 Then st(n, 2) = sp(2) / sp(3)
If sp(5) > 0 Then st(n, 3) = sp(4) / sp(5)
 
Ik heb de code flexibeler gemaakt:

- het aantal kolommen met basisgegevens kan naar wens beperkt of uitgebreid worden
- de eerste kolom bevat altijd de tijdregistraties
- het resultaat komt altijd 2 kolommen achter de tabel met basisgegevens.

Of de tabel nu 1 kolom met gegevens heeft of 24, de code hoeft daarvoor niet aangepast te worden.
Omdat alles in het werkgeheugen plaatsvindt blijft de code snel.
De beperkingen van werkbladfunkties als index en transpose zijn vermeden.
De interaktie met het werkblad is beperkt tot 1 maal lezen en 1 maal schrijven.

Code:
Sub M_snb()
  c00 = "yyyy-mm-dd hh:00"
  sn = Blad4.Cells(1).CurrentRegion
  ReDim sq(UBound(sn, 2) - 1)
    
  y = DateDiff("h", sn(2, 1), sn(UBound(sn), 1))
  With CreateObject("scripting.dictionary")
    For j = 0 To y
      .Item(Format(sn(2, 1) + j / 24, c00)) = sq
     Next
       
    For j = 2 To UBound(sn)
      c01 = Format(sn(j, 1), c00)
      sp = .Item(c01)
      sp(0) = sp(0) + 1
      For jj = 1 To UBound(sp)
        sp(jj) = sp(jj) + sn(j, jj + 1)
      Next
      .Item(c01) = sp
    Next
       
    ReDim st(.Count, UBound(sn, 2) - 1)
    st(0, 0) = "Time"
    For j = 1 To UBound(st, 2)
      st(0, j) = "Average " & sn(1, j + 1)
    Next
       
    For Each it In .keys
      n = n + 1
      sp = .Item(it)
      st(n, 0) = it
      For j = 1 To UBound(st, 2)
        If sp(0) > 0 Then st(n, j) = sp(j) / sp(0)
      Next
    Next
  End With
       
  Blad4.Cells(1, UBound(sn, 2) + 3).Resize(UBound(st) + 1, UBound(st, 2) + 1) = st
End Sub
 
Laatst bewerkt:
Ik heb de daggemiddelden nu ook toegevoegd.
Na de gemiddeldegegevens komt een kolom met data, daarna de gemiddelden per meetwaarde op de laatste regel van iedere dag.

NB. Er zat een fout in de code wardoor de daggemidddelden niet correct waren.
Dat is nu hersteld.
Code:
Sub M_snb()
    Application.ScreenUpdating = False
    c00 = "yyyy-mm-dd hh:00"
    sn = Blad4.Cells(1).CurrentRegion
    ReDim sq(UBound(sn, 2) - 1)
    y = Int(24 * (sn(UBound(sn), 1) - sn(2, 1))) + 1
    
    With CreateObject("scripting.dictionary")
       For j = 0 To y
          .Item(Format(sn(2, 1) + j / 24, c00)) = sq
       Next
       
       For j = 2 To UBound(sn)
          c01 = Format(sn(j, 1), c00)
          sp = .Item(c01)
          sp(0) = sp(0) + 1
          For jj = 1 To UBound(sp)
             sp(jj) = sp(jj) + sn(j, jj + 1)
          Next
          .Item(c01) = sp
       Next
       
       ReDim st(.Count, UBound(sn, 2) - 1)
       st1 = st
       
       st(0, 0) = "Time"
       st1(0, 0) = "Datum"
       For j = 1 To UBound(st, 2)
          st(0, j) = "Average " & sn(1, j + 1)
          st1(0, j) = st(0, j)
       Next
       
       For Each it In .keys
          If n = 0 Then sd = sq
          If n > 0 Then
              If Left(it, 10) <> Left(st(n, 0), 10) Then
                st1(n, 0) = Left(st(n, 0), 10)
                For j = 1 To UBound(sd)
                   If sd(0) > 0 Then st1(n, j) = sd(j) / sd(0)
                Next
                sd = sq
               End If
          End If
          
          n = n + 1
          sp = .Item(it)
          st(n, 0) = it
          sd(0) = sd(0) + sp(0)
          For j = 1 To UBound(st, 2)
             If sp(0) > 0 Then st(n, j) = sp(j) / sp(0)
             sd(j) = sd(j) + sp(j)
          Next
       Next
     End With
    
     st1(n, 0) = Left(st(n, 0), 10)
     For j = 1 To UBound(sd)
        If sd(0) > 0 Then st1(n, j) = sd(j) / sd(0)
     Next
       
    With Blad4.Cells(1, UBound(sn, 2) + 3)
        .Resize(UBound(st) + 1, UBound(st, 2) + 1) = st
        .Offset(, UBound(st, 2) + 1).Resize(UBound(st) + 1, UBound(st, 2) + 1) = st1
        .CurrentRegion.Columns(1).NumberFormat = "dd-mm-yyyy hh:mm"
        .CurrentRegion.Offset(, 1).NumberFormat = "0.00"
        .CurrentRegion.Columns(UBound(st, 2) + 2).NumberFormat = "dd-mm-yyyy"
   End With
End Sub
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan