Eerste en laatste datum met Urenstanden

Status
Niet open voor verdere reacties.
P

Peter2016

Gebruiker
Lid geworden
4 sep 2015
Berichten
89
na een eerdere oplossing om laatste urenstand over te houden, probeer ik het bestand efficiënter en completer te maken.

Ik heb een groot data bestand variabel met ca. 25.000 records

Ik zou graag de eerste datum met urenstand in kolom K,L en de laatste datum met urenstand in kolom M,N. hebben, en alle tussenliggende data verwijderen.

Een recordregel wordt bepaald als kolom A,C,D gelijk aan elkaar zijn. (zie bijlage).

Ik hoop dat dit kan :)
 

Bijlagen

  • Eerste laatste datum met urenstand.xlsx
    14,6 KB · Weergaven: 50
Misschien een betere uitleg van jouw kant.

Het resultaat in je voorbeeld van grootste sq kleinste datum strookt niet met de repairdatum.

Daarom deze code.
Code: 
Sub hsv()
Dim sn, sq
With Sheets("iscala data").Cells(1).CurrentRegion
 sn = .Value
      .Sort [i1], 2, , , , , , 1
      .RemoveDuplicates Array(1, 3, 4)
      sq = .Offset(1).Value
      .Value = sn
      .Sort [i1], 1, , , , , , 1
      .RemoveDuplicates Array(1, 3, 4)
      .Parent.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(sq), UBound(sn, 2)) = sq
      .Sort [a1], , [d1], , , [i1], , 1
 End With
End Sub
 
Hallo Harry,

Ik had de repairdate ook weg moeten halen, stom en verwarrend.
Ik probeer het duidelijk te maken, heb bestand aangepast met tabblad met data, en tabblad resultaat zoals het er dan uit komt te zien.
Data (nu als voorbeeld) = A2 tm J30, normaal A2 tm ca. J250000.
Regel 2 tm 7 is 1 configuratie
Regel 8 tm 25 is 1 configuratie
Regel 26 tm 27 is 1 configuratie
Regel 28 tm 30 is 1 configuratie
Er zijn in dit voorbeeld dus 4 configuraties.

Van de eerste configuratie (regel 2 tm 7)
de eerste datum 9-9-2015, dus die komt in kolom K, de daarbij behorende tellerstand 2598 in kolom L;
de laatste datum 25-7-2017, in kolom M; met tellerstand 3220 in kolom N
In het Tab "resultaat" is van regel 2 tm 7 alleen nog regel 2 overgebleven, met de waardes in kolom K,L,M,N.

voor 2e configuratie (regel 8 tm 25) is regel 3 in het tab resultaat overgebleven
voor 3e configuratie (regel 26 tm 27) is regel 4 in het tab resultaat overgebleven, enz.

Ik hoop dat ik het een beetje begrijpbaar heb kunnen maken.

In ieder geval alvast bedankt voor je hulp.Bekijk bijlage Eerste laatste datum met urenstand.xlsx
 
Laatst bewerkt:
Peter,

Zie het resultaat in blad1.
 

Bijlagen

  • Eerste laatste datum met urenstand 2.xlsb
    27,2 KB · Weergaven: 38
Super Harry, ik ga van de week 25000 records erop los laten. Zoals het er nu uitziet doet het precies wat ik bedoelde. Heel erg bedankt voor je hulp :)
 
Bekijk bijlage UrenScanner check.xlsbHallo Harry (hsv),

Het heeft even geduurd voordat ik kon testen.
Zou je de vba code een keer kunnen controleren. Als ik een klein aantal records pak gaat het goed. Als ik de code over 25.000 records laat lopen is de laatste datum met tellestand niet goed.
Ik heb een voorbeeld van de betreffende record met resultaat erbij gedaan. (stond ergens op regel 8500). De foutieve waarde (9044 & 15-8-2017) komt bij een andere record vandaan.

Alvast bedankt Harry

Groet
Peter
 
Hallo Peter,

Helaas kan ik niet controleren waar het fout gaat.
Dit bestand wat je plaatste heeft te weinig regels en dit gaat goed zoals je schrijft.
 
Jammer, op zich is ie supersnel. Denk dat ik anders eerst een tabblad opbouw met eerste stand, daarna tab met laatste stand en deze samenvoeg.
 
Ik gebruik kolom J als eerste datum en kolom K als laatste datum, kolom M en N zijn dan overbodig.

Code: 
Sub M_snb()
  sn = Sheets("Iscala Data").Cells(1).CurrentRegion
    
  With CreateObject("scripting.dictionary")
    For j = 2 To UBound(sn)
      c00 = sn(j, 1) & "_" & sn(j, 3) & "_" & sn(j, 4)
           
      sp = Application.Index(sn, j)
      sp(9) = 1 * CDate(sp(9))
      If .exists(c00) Then sp = .Item(c00)
           
      If sn(j, 9) < sp(9) Then
        sp(9) = sn(j, 9)
        sp(10) = sn(j, 10)
      End If
      If sn(j, 9) > sp(11) Then
        sp(11) = sn(j, 9)
        sp(12) = sn(j, 10)
      End If
           
      .Item(c00) = sp
    Next
       
    Sheets("Iscala Data").Cells(20, 1).Resize(.Count, UBound(sn, 2)) = Application.Index(.items, 0, 0)
  End With
End Sub
 
Laatst bewerkt:
Hallo Snb,

Probeer die van jou, maar krijg melding "Compileerfout: Een variabele is niet gedefinieerd.
 
Verwijder Option Explicit (les 1; VBA)
 
draait nu wel, maar blijft draaien en komt er niet meer uit. Zou ie geen 25.000 records aankunnen?
 
Toon svp de code die je laat draaien en een exact voorbeeld van het werkblad met de gegevens.
Test dit eens:

Code: 
Sub M_snb()
  sn = Sheets("Iscala Data").Cells(1).CurrentRegion
    
  With CreateObject("scripting.dictionary")
    For j = 2 To UBound(sn)
      c00 = sn(j, 1) & "_" & sn(j, 3) & "_" & sn(j, 4)
           
      sp = Application.Index(sn, j)
      sp(9) = 1 * CDate(sp(9))
      If .exists(c00) Then sp = .Item(c00)
           
      If sn(j, 9) < sp(9) Then
        sp(9) = sn(j, 9)
        sp(10) = sn(j, 10)
      End If
      If sn(j, 9) > sp(11) Then
        sp(11) = sn(j, 9)
        sp(12) = sn(j, 10)
      End If
           
      .Item(c00) = sp
    Next

    msgbox .count
  end with
End Sub
 
Deze doet het bij mij:

Code: 
Sub M_snb()
  sn = Sheets("Iscala Data").Cells(1).CurrentRegion
    
  With CreateObject("scripting.dictionary")
    For j = 2 To UBound(sn)
      c00 = sn(j, 1) & "_" & sn(j, 3) & "_" & sn(j, 4)
      c01 = c00 & "_min"
      c02 = c00 & "_max"
      c03 = c00 & "_uur"
      If .exists(c01) Then
          If sn(j, 9) < .Item(c01) Then .Item(c01) = sn(j, 9)
      Else
         .Item(c01) = sn(j, 9)
      End If
      If .exists(c02) Then
          If sn(j, 9) > .Item(c02) Then .Item(c02) = sn(j, 9)
      Else
         .Item(c02) = sn(j, 9)
         .Item(c03) = sn(j, 10)
      End If
    Next

    For j = 2 To UBound(sn)
      c00 = sn(j, 1) & "_" & sn(j, 3) & "_" & sn(j, 4)
      c01 = c00 & "_min"
      c02 = c00 & "_max"
      c03 = c00 & "_uur"
      If sn(j, 9) = .Item(c01) Then
         sn(j, 11) = .Item(c02)
         sn(j, 12) = .Item(c03)
      End If
    Next
  End With
  
  Blad3.Cells(1).Resize(UBound(sn), UBound(sn, 2)) = sn
  Blad3.Columns(11).SpecialCells(4).EntireRow.Delete
End Sub

Maar het lukt zowaar ook nog met een draaitabel:
 

Bijlagen

  • __UrenScanner snb.xlsb
    1 MB · Weergaven: 190
Laatst bewerkt:
Bekijk bijlage UrenScanner V2 1-11-2017.xlsbHallo Snb, Allereerst bedankt dat je de moeite doet om te helpen.
Ik heb de vbacode gedraaid, en vult alleen de eerste datum, kolom met laatste datum en tellerstand blijft leeg?
Is het mogelijk dat deze dan ook meteen wordt gevuld, dat zou geweldig zijn.
(zie bijlage
 
Kijk eens goed naar het resultaat en de toelichtende tekst uit #9
Probeer ook de code te begrijpen.
Laat je niet in de war brengen door de kolomnamen.
 
De datum is goed, alleen de tellerstand is niet die bij de datum hoort(is van de eerste datum)
 
Maak een nieuwe tabblad aan genaamd blad2 en test het eens.
Code: 
Sub hsv()
Dim sv, a, b(11), i As Long, j As Long
sv = Sheets("iscala data").Cells(1).CurrentRegion
      With CreateObject("scripting.dictionary")
       For i = 2 To UBound(sv)
           a = .Item(sv(i, 1) & sv(i, 3) & sv(i, 4))
             If IsEmpty(a) Then a = b
               For j = 1 To 8
                    a(j - 1) = sv(i, j)
               Next j
                  a(8) = IIf(IsEmpty(a(8)), clng(sv(i, 9)), IIf(a(8) > sv(i, 9), CLng(sv(i, 9)), a(8)))
                  a(9) = IIf(IsEmpty(a(9)), sv(i, 10), IIf(a(9) > sv(i, 9), sv(i, 10), a(9)))
                  a(10) = IIf(a(10) < sv(i, 9), CLng(sv(i, 9)), a(10))
                  a(11) = IIf(a(11) < sv(i, 9), sv(i, 10), a(11))
              .Item(sv(i, 1) & sv(i, 3) & sv(i, 4)) = a
            Next i
     Sheets("blad2").Cells(1).Resize(.Count, 12) = Application.Index(.items, 0, 0)
 End With
End Sub
 
Laatst bewerkt:
Ja Harry, dat is 'm :thumb:. Ben er heel blij mee. Super bedankt en ook snb voor jouw bijdrage.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan