lege cellen moeten datum krijgen

Spiesse · 19 jun 2012

beste,

kan één der cracks mij helpen? Ik raak maar niet aan de juiste formule of macro om iets tot stand te krijgen...

het bestand in bijlage bevat in kolom A enkel datums... x aantal regels moeten dezelfde datum krijgen. om vlug en efficient te werken zou ik maar om de x aantal regels de datum willen invullen als die moet veranderd worden...

het bestand in bijlage legt ook uit hoe en wat...

kan iemand es een oog werpen op dit euvel?

alvast bedankt!

spiesse

Bekijk bijlage datum automatisch aanvullen in lege cellen.xlsx

Niels28 · 19 jun 2012

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:A")) Is Nothing Then
For Each cl In Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
If cl.Value = "" Then cl.FillDown
Next
End If
End Sub

Niels

Spiesse · 19 jun 2012

ah de niels

de vraag is eigenlijk een 'vervolg' op de macro van gisteren die je me gaf

waar ergens zou ik deze moeten invoegen om te laten werken?

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next
'overslaan cellen
If Target.Column = 1 Then Target.Offset(0, 2).Select
If Target.Column = 3 Then Target.Offset(0, 6).Select
        'uren omzetten
If Not Intersect(Target, Range("i16943:j500000")) Is Nothing Then
    If Not IsEmpty(Target) Then
    
    If Hour(Target.Value) = 0 Or Minute(Target.Value) = 0 Then
        Application.EnableEvents = False
            If Int(Target.Value / 100) < 0.1 Then
                Target = "00:" & Target.Value
                Else
                Target = Int(Target.Value / 100) & ":" & Right(Target.Value, 2)
            End If
        Application.EnableEvents = True
        hw = (Target - Target.Offset(, -1)) * 24 - Pause(Target.Offset(, -1), Target, Range("O2:P4")) * 24
        If Target.Column = 10 Then Target.Offset(0, 2) = IIf(hw > 0, Round(hw, 2), "")
        End If
    End If
End If
'If Not Intersect(Target, Range("H:H")) Is Nothing Then
    'Target.NumberFormat = "General"
    'Application.EnableEvents = False
    'Target = CDate(Left(Format(CStr(Target.Value), "0000"), 2) & "-" & Right(CStr(Target.Value), 2) & "-" & Year(Date))
    'Application.EnableEvents = True
'End If

ActiveCell.Calculate

End Sub

thx! spiesse

Niels28 · 19 jun 2012

Zo?

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next
'overslaan cellen
If Target.Column = 1 Then Target.Offset(0, 2).Select
If Target.Column = 3 Then Target.Offset(0, 6).Select
        'uren omzetten
If Not Intersect(Target, Range("i16943:j500000")) Is Nothing Then
    If Not IsEmpty(Target) Then
    
    If Hour(Target.Value) = 0 Or Minute(Target.Value) = 0 Then
        Application.EnableEvents = False
            If Int(Target.Value / 100) < 0.1 Then
                Target = "00:" & Target.Value
                Else
                Target = Int(Target.Value / 100) & ":" & Right(Target.Value, 2)
            End If
        Application.EnableEvents = True
        hw = (Target - Target.Offset(, -1)) * 24 - Pause(Target.Offset(, -1), Target, Range("O2:P4")) * 24
        If Target.Column = 10 Then Target.Offset(0, 2) = IIf(hw > 0, Round(hw, 2), "")
        End If
    End If
End If

If Not Intersect(Target, Range("A:A")) Is Nothing Then
Application.EnableEvents = False
For Each cl In Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
If cl.Value = "" Then cl.FillDown
Next
Application.EnableEvents = True
End If

If Not Intersect(Target, Range("H:H")) Is Nothing Then
    Target.NumberFormat = "General"
    Application.EnableEvents = False
    Target = CDate(Left(Format(CStr(Target.Value), "0000"), 2) & "-" & Right(CStr(Target.Value), 2) & "-" & Year(Date))
    Application.EnableEvents = True
End If

ActiveCell.Calculate

End Sub

Niels

Spiesse · 19 jun 2012

niels,

er verandert niet echt iets... heb uw nieuw stukje veranderd naar de juiste kolom maar noppes...

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next
'overslaan cellen
If Target.Column = 1 Then Target.Offset(0, 2).Select
If Target.Column = 3 Then Target.Offset(0, 6).Select
        'uren omzetten
If Not Intersect(Target, Range("i16943:j500000")) Is Nothing Then
    If Not IsEmpty(Target) Then
    
    If Hour(Target.Value) = 0 Or Minute(Target.Value) = 0 Then
        Application.EnableEvents = False
            If Int(Target.Value / 100) < 0.1 Then
                Target = "00:" & Target.Value
                Else
                Target = Int(Target.Value / 100) & ":" & Right(Target.Value, 2)
            End If
        Application.EnableEvents = True
        hw = (Target - Target.Offset(, -1)) * 24 - Pause(Target.Offset(, -1), Target, Range("O2:P4")) * 24
        If Target.Column = 10 Then Target.Offset(0, 2) = IIf(hw > 0, Round(hw, 2), "")
        End If
    End If
End If

If Not Intersect(Target, Range("A:A")) Is Nothing Then
Application.EnableEvents = False
For Each cl In Range("h1:h" & Cells(Rows.Count, "h").End(xlUp).Row)
If cl.Value = "" Then cl.FillDown
Next
Application.EnableEvents = True
End If
If Not Intersect(Target, Range("H:H")) Is Nothing Then
    Target.NumberFormat = "General"
    Application.EnableEvents = False
    Target = CDate(Left(Format(CStr(Target.Value), "0000"), 2) & "-" & Right(CStr(Target.Value), 2) & "-" & Year(Date))
    Application.EnableEvents = True
End If

ActiveCell.Calculate

End Sub

zit ik ergens met een ongezien foutje?

Niels28 · 19 jun 2012

Je moet al wel in H1 een waarde hebben staan anders gaat het fout.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next
'overslaan cellen
If Target.Column = 1 Then Target.Offset(0, 2).Select
If Target.Column = 3 Then Target.Offset(0, 6).Select
        'uren omzetten
If Not Intersect(Target, Range("i16943:j500000")) Is Nothing Then
    If Not IsEmpty(Target) Then

    If Hour(Target.Value) = 0 Or Minute(Target.Value) = 0 Then
        Application.EnableEvents = False
            If Int(Target.Value / 100) < 0.1 Then
                Target = "00:" & Target.Value
                Else
                Target = Int(Target.Value / 100) & ":" & Right(Target.Value, 2)
            End If
        Application.EnableEvents = True
        hw = (Target - Target.Offset(, -1)) * 24 - Pause(Target.Offset(, -1), Target, Range("O2:P4")) * 24
        If Target.Column = 10 Then Target.Offset(0, 2) = IIf(hw > 0, Round(hw, 2), "")
        End If
    End If
End If

If Not Intersect(Target, Range("H:H")) Is Nothing Then
    Target.NumberFormat = "General"
    Application.EnableEvents = False
    Target = CDate(Left(Format(CStr(Target.Value), "0000"), 2) & "-" & Right(CStr(Target.Value), 2) & "-" & Year(Date))
    For Each cl In Range("H1:H" & Cells(Rows.Count, "H").End(xlUp).Row)
If cl.Value = "" Then cl.FillDown
Next
    Application.EnableEvents = True
End If

ActiveCell.Calculate

End Sub

Niels

Spiesse · 19 jun 2012

ik denk dat het dan h2 moet worden. die bevat een datum. h1 bevat de hoofding, genoemd datum...
ik probeer opnieuw..

Spiesse · 19 jun 2012

als ik bv een tiental regels onder de laatste invoer een datum invoer, dan voert hij de data in naar beneden toe... zou moeten de lege cellen boven de nieuwe datum zijn die aangevuld worden.

moet ik dan de .filldown veranderen naar .fillup ?

Niels28 · 19 jun 2012

Sorry ik begrijp je niet meer.

uit je excel bestand:

als een datum in kolom A verandert, dan zouden alle lege cellen erboven gevuld moeten worden met de vorige datum. dus in A2:A7 moet 15/06/2012 komen, in A9:A21 16/06/2012 vanaf A23 moet het nog leeg blijven, tot bv A45 een andere datum krijgt…

Dit doet ie nu toch, de oude datum aanvullen tot de nieuwe.

Niels

Spiesse · 19 jun 2012

ja, echter als ik de nieuwe datum invoer, dan overschrijft hij de nieuwe datum en loopt hij door naar beneden...

Niels28 · 19 jun 2012

Sorry geen last van, zie bijlage, heb het bovenste deel van je macro uitgeschakeld omdat dit bij mij niet werkt.

Bekijk bijlage datum aanvullen.xlsm

Typ bv in H62 een datum, dan doet ie toch wat je vraagt?

Niels

Spiesse · 19 jun 2012

in uw bestand doet die het perfect, zoals het moet... nu is mijn bestand opgebouwd uit een tabel die pakweg 3000 lege regels bevat onder de laatste regel omdat dit vroeger een probleem gaf met de vlotheid van mijn bestand...

als je nu bv van kolom h een tabel maakt maar bv 40 regels meer voorziet, en dan de macro doet lopen, dan ga je zien dat hij doorloopt tot het einde van de tabel... wil je dit es proberen?

thx!

Niels28 · 19 jun 2012

Ooh.. maar dat is eenvoudig op te lossen..

2x end(xlup) je moet van alleen zorgen dat de rijen van je tabel niet opraken.

Code:

If Not Intersect(Target, Range("H:H")) Is Nothing Then
    Target.NumberFormat = "General"
    Application.EnableEvents = False
    Target = CDate(Left(Format(CStr(Target.Value), "0000"), 2) & "-" & Right(CStr(Target.Value), 2) & "-" & Year(Date))
    For Each cl In Range("H1:H" & Cells(Rows.Count, "H").[COLOR="#FF0000"]End(xlUp).End(xlUp).[/COLOR]Row)
If cl.Value = "" Then cl.FillDown
Next
    Application.EnableEvents = True
End If

Het kan ook met een end(xldown) maar dan werkt het weer niet als je lege regels er tussen hebt.

Niels

Spiesse · 19 jun 2012

ja niels, we zijn er. alé, jij bent er

hoe je het doet, super gewoon!!!!!! je gaat me nie zeggen dat je dat puur uit hobby doet he?

hoe dan ook, je bent een meerwaarde voor velen denk ik!!!

greets spiesse

Niels28 · 19 jun 2012

Toch wel als hobby.
Maar daar zijn ze op mijn werk ook achter gekomen dus daar maak ik ook regelmatig programma's.

Niels

Spiesse · 19 jun 2012

niels,
kan je de macro ook aanpassen dat hij de laatst ingevulde datum invult naar boven toe, tot aan de laatst beschreven cel, zijnde een andere datum?

Niels28 · 19 jun 2012

Code:

If Not Intersect(Target, Range("H:H")) Is Nothing Then
    Target.NumberFormat = "General"
    Application.EnableEvents = False
    Target = CDate(Left(Format(CStr(Target.Value), "0000"), 2) & "-" & Right(CStr(Target.Value), 2) & "-" & Year(Date))
For i = Target.Row - 1 To Target.End(xlUp).Row Step -1
If Cells(i, "H").Value = "" Then Cells(i, "H").FillUp
Next
    Application.EnableEvents = True
End If

Niels

Spiesse · 19 jun 2012

super!!!! ik zet deze op opgelost!!!!

ps: ben je op een privé manier bereikbaar voor hulp? of enkel via forum?

Niels28 · 19 jun 2012

Enkel via het forum.

Niels

Spiesse · 19 jun 2012

blijf wakker zou ik zeggen

lege cellen moeten datum krijgen

Gebruiker

Terugkerende gebruiker

Gebruiker

Terugkerende gebruiker

Gebruiker

Terugkerende gebruiker

Gebruiker

Gebruiker

Terugkerende gebruiker

Gebruiker

Terugkerende gebruiker

Gebruiker

Terugkerende gebruiker

Gebruiker

Terugkerende gebruiker

Gebruiker

Terugkerende gebruiker

Gebruiker

Terugkerende gebruiker

Gebruiker

Wij waarderen jouw privacy