HSV, Eerste datum met tellerstand ook toevoegen

[1965Peter]

Hallo (Hsv),

Je hebt voor mij een mooie vba gemaakt waarbij ik de laatste datum met bijbehorende urenstand ingevuld krijg. (wordt veel gebruikt).
Nu zou ik graag ook de eerste datum met bijbehorende tellerstand willen hebben in kolom J & K.
Ik heb heel veel geprobeerd, maar krijg het niet voor elkaar.

Alvast bedankt weer.

 

[1965Peter]

Sub hsv()
Dim cl As Range, c As Range
 For Each cl In Sheets("urenberekening").Cells(5, 3).CurrentRegion.Offset(1)
   Set c = Sheets("urenoverzicht").Columns(1).Find(cl, , , , , 2)
   If Not c Is Nothing Then cl.Offset(, 9).Resize(, 2) = c.Offset(, 2).Resize(, 2).Value
 Next cl
End Sub

 

[VenA]

Waarom zo'n rommelige opzet met lege rijen en dubbelde kolomkoppen?

Met een paar formules werkt het ook prima en heb je geen VBA nodig.

 

[1965Peter]

VenA Lege rijen zijn wel gevuld voor een bepaald format. Helaas weet ik de formules niet. Probleem is ik moet de eerste & laatste datum hebben, MET daarbij de ingevoerde tellerstand. Ik kan me voorstellen dat je in een formule de laatste en eerste datum pakt, en de kleinste en hoogste tellerstand, alleen het probleem is dat het in werkelijkheid niet zo is. Die tellestand klopt niet altijd door allerlei redenen. De rapportage moet dus echt de werkelijke invoer laten zien.
Vandaar eerste en laatste datum met de daarbij ingevoerde tellerstand. De vba van Hsv deed precies wat ie moest doen vandaar.

 

[HSV]

Maak van de 9 eens een 7.

cl2.Offset(, [COLOR=#ff0000]9[/COLOR]).Resize(, 2)

 

[1965Peter]

HSV, Daar was ik wel al achter, maar als ik 'm 2x gebruik, één voor de eerste datum, twee voor de laatste datum, dan doet de ander het weer niet.
Ik dacht misschien kon de code zo worden aangepast, dat in 1 code de 4 kolommen gevuld zouden worden.

 

[HSV]

Dat kan ook Peter.

Sub hsv()
Dim cl As Range, c As Range, i As Long
 For Each cl In Sheets("urenberekening").Cells(5, 3).CurrentRegion.Offset(1)
 For i = 1 To 2
   Set c = Sheets("urenoverzicht").Columns(1).Find(cl, , , , , i)
   If Not c Is Nothing Then cl.Offset(, IIf(i = 1, 7, 9)).Resize(, 2) = c.Offset(, 2).Resize(, 2).Value
   Next i
 Next cl
End Sub

 

[1965Peter]

HSV, yes. Super Bedankt. Ben er blij mee.

 

[HSV]

Zo kan het ook nog in je voorbeeldbestand

Code is langer, maar sneller, een keer wegschrijven i.p.v. meerdere keren.

Sub hsv()
Dim sv, sq, c As Range, i As Long
With Sheets("urenberekening").Cells(5, 3).CurrentRegion.Offset(1)
sv = .Resize(, 11)
 For i = 1 To UBound(sv) - 1
  Set c = Sheets("urenoverzicht").Columns(1).Find(sv(i, 1))
    If Not c Is Nothing Then
      sq = c.CurrentRegion.Offset(1).Resize(, 4)
        sv(i, 8) = Format(sq(1, 3), "mm/dd/yyyy")
        sv(i, 9) = sq(1, 4)
        sv(i, 10) = Format(sq(UBound(sq) - 1, 3), "mm/dd/yyyy")
        sv(i, 11) = sq(UBound(sq) - 1, 4)
    End If
  Next i
 .Resize(, 11) = sv
End With
End Sub

 

[1965Peter]

Hsv, ga deze ook proberen. Bedankt voor je hulp.