Weeknummer automatisch invullen door middel van VBA

[Killerman1991]

Hallo iedereen,

Ik zit met het volgende probleem:

Ik ben bezig met een excel bestand voor een logboek.
De datum wordt al automatisch ingevuld, maar ik wil ook graag de weeknummer automatisch ingevuld wordt.
Dit is wel gelukt via een formule, maar dan komt er ook een getal te staan als er geen datum aanwezig is.
Ik wil graag dat de cellen zonder datum ook geen weeknummer krijgen.
Dus stel B2 heeft een datum dan moet A2 een weeknummer krijgen, maar als B2 leeg is moet A2 ook leeg blijven.

Ik heb al op een aantal websites gekeken, maar kom er niet uit.

Alvast bedankt voor de hulp:thumb:

 

[HSV]

Test het maar eens.

Sub hsv()
 Application.EnableEvents = False
 on error resume next
  For Each cl In Columns(2).SpecialCells(2)
     cl.Offset(, -1) = DatePart("ww", cl, vbMonday, vbFirstFourDays)
   Next cl
 Application.EnableEvents = True
 End Sub

 

[Killerman1991]

Ik heb dit getest maar het werkt niet, er gebeurd niks.

In mijn bestand staat in kolom B staan de datums en dat begint vanaf B4.
Dus vanaf A4 wil ik weeknummers krijgen, wanneer in B4 een datum komt.
Dit moet natuurlijk oneindig doorgaan.

 

[roeljongman]

je bent er bijna..

voeg

Target.Offset(0, -2).Value = DatePart("ww", Date, vbMonday, vbFirstFourDays)

in na

Target.Offset(0, -1).Value = Date

dan zal het weeknummer in kolom A komen

 

[Killerman1991]

Dankjewel het werk nu top, nu wil ik ook graag de tijd nog automatisch hebben.
Weet jij toevallig ook hoe dit moet?

 

[roeljongman]

wijzig "Date" in "Now" en je hebt in de datum kolom zowel de datum als de tijd,

Target.Offset(0, -1).Value = Now

wil je de tijd in een aparte kolom dan kun je ook een extra regel toevoegen en "Time" gebruiken en dan in offset de -1 vervangen door een ander getal tot het in de juiste kolom staat.

 

[HSV]

Zet het dan in de change-event van bladmodule.

 

[snb]

waarom niet gewoon een formule gebruiken ?

=weeknum(A1;21)

 

[Killerman1991]

Dankjewel voor de duidelijk uitleg.
Alles werkt prima naar behoren. Echter is de office versie in het engels, waardoor de datum en tijdnotatie ook in het engels is.
Het is niet mogelijk om office nederlands te maken, omdat dit via mijn werk gaat.
Het grootste probleem zit hem in de tijdnotatie omdat die nu met AM en PM werkt.

Weet jij of iemand anders de oplossing hiervoor?
Had zelf al even gezocht op internet maar kom daar niet helemaal uit, omdat het invullen via VBA gebeurd.

alvast bedankt.

 

[Killerman1991]

waarom niet gewoon een formule gebruiken ?

=weeknum(A1;21)

Als ik het met deze formule doe, dan krijgen de cellen zonder datum week nummer 52.
Dus als B1 geen datum heeft word A1 (die het weeknummer weergeeft) week 52.

 

[popipipo]

=if(B1="";"";weeknum(A1;21)
Zo niet meer

 

[Killerman1991]

Alles werkt nu naar behoren, echter wil ik nog een optimalisatie creëren.
Nu moet je nog aangeven welke dienst je bent ochtend,middag, of avond. Dit is natuurlijk tijd gerelateerd.
In de cell ernaast word ingevuld welke ploeg het is dus A,B of C.

Is het mogelijk dat wanneer ik ploeg A,B of C invoer de dienst ook ingevuld word.
Stel ik vul tussen 06:00 tot 13:59 onder het kopje ploeg A,B of C in dat er onder het kopje dienst automatisch ochtend komt te staan.
Wanneer ik tussen 14:00 tot 21:59 onder het kopje ploeg A,B of C in vul, dat er onder het kopje dienst automatisch middag komt te staan.
En wanneer ik tussen 22:00 tot 05:59 onder het kopje ploeg A,B of C in vul, dat er onder het kopje dienst automatisch nacht komt te staan.

Alvast bedankt voor de moeite:thumb:

 

[roeljongman]

ja hoor dat kan ook

Bekijk bijlage Kopie van Logboek-1.xlsm

ik heb het getest met verschillende tijdzones in te stellen op mijn pc en dit werkt.

 

[Killerman1991]

Hij werkt goed, alleen als het precies 22:00 is dan is hij in de war.

Daarom heb ik de tijden aangepast:

If Target.Offset(0, -2).Value >= TimeValue("0:00:00") And Target.Offset(0, -2).Value < TimeValue("5:59:59") Then Target.Offset(0, -1).Value = "Nacht"
If Target.Offset(0, -2).Value >= TimeValue("6:00:00") And Target.Offset(0, -2).Value < TimeValue("13:59:59") Then Target.Offset(0, -1).Value = "Ochtend"
If Target.Offset(0, -2).Value >= TimeValue("14:00:00") And Target.Offset(0, -2).Value < TimeValue("21:59:59") Then Target.Offset(0, -1).Value = "Middag"
If Target.Offset(0, -2).Value >= TimeValue("22:00:00") And Target.Offset(0, -2).Value < TimeValue("00:00:00") Then Target.Offset(0, -1).Value = "Nacht"

Heel erg bedankt voor je hulp en tijd, ik ben zelf niet super goed in excel.:thumb:

 

[roeljongman]

ok maar dat was niet het probleem.. ik denk dat je om tussen 22u en 23:59 nog steeds een probleempje kan hebben..
ik zag een foutje in mijn eigen code, in de 4e regel staat 0:00:00 en die veroorzaakt het probleem. die test namelijk dat de tijd kleiner moet zijn dan 0 en dat is nooit waar.
dus die moet je aanpassen naar 23:59:59 en dan <= ervoor..
(en 22:00:00 op de 3e regel laten staan / terugzetten)

If Target.Offset(0, -2).Value >= TimeValue("0:00:00") And Target.Offset(0, -2).Value < TimeValue("5:59:59") Then Target.Offset(0, -1).Value = "Nacht"
If Target.Offset(0, -2).Value >= TimeValue("6:00:00") And Target.Offset(0, -2).Value < TimeValue("13:59:59") Then Target.Offset(0, -1).Value = "Ochtend"
If Target.Offset(0, -2).Value >= TimeValue("14:00:00") And Target.Offset(0, -2).Value < TimeValue("22:00:00") Then Target.Offset(0, -1).Value = "Middag"
If Target.Offset(0, -2).Value >= TimeValue("22:00:00") And Target.Offset(0, -2).Value[B] <= TimeValue("23:59:59")[/B] Then Target.Offset(0, -1).Value = "Nacht"

 

[Killerman1991]

Ik zal dit straks even testen. Ik heb nog een vraag.
Hoop dat je dat niet erg vindt

Ik kan mij voorstellen dat iemand een keer perrongeluk op de verkeerde cel klikt.
Stel de eerste cel is ingevuld in mij geval cel E4 dan worden A4 tot E4 ingevuld.
Maar als ik vervolgens E5 in wil vullen en ik klik E4 perrongeluk aan en pas daar de ploeg aan bijv van B naar C dan worden de cellen A4 tot E4 gewijzigd.

Dat moet voorkomen worden. Mijn vraag is kun je cel E4 beveiligen dat je eenmalig de ploeg kan selecteren en wanneer de cel ingevuld is en je perrongeluk verkeerd klikt dat hij een error geeft.
Anders ben je de data kwijt die in A4 tot E4 stond en kun je dit niet met de terug knop oplossen aangezien het automatisch ingevuld wordt.

Verder mogen de andere cellen die met de hand ingevuld worden ook na invullen beveiligd worden dat niemand dit meer kan aanpassen. (dit zou tijdgestuurd mogen worden bijv dat na 10 min deze cellen op slot gaan) (dit is bijzaak als dit niet lukt of teveel werk is dan hoeft dit niet perce)

Ik hoop dat dit kan en alvast bedankt voor je super hulp:d:thumb:

 

[VenA]

De code zou ik reduceren tot

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 5 And Target.Count = 1 Then
    With Target
        If .Value <> "" Then
            If Application.CountA(.Offset(, -4).Resize(, 4)) <> 4 Then
                .Offset(, -4).Resize(, 4) = Array(DatePart("ww", Date, vbMonday, vbFirstFourDays), Date, Time, Application.Lookup(Time * 24, Array(0, 6, 14, 22), Array("Nacht", "Ochtend", "Middag", "Nacht")))
            End If
          Else
            .Offset(, 5).Resize(, 2) = ""
        End If
    End With
End If
End Sub

Het per ongeluk wijzigen is hiermee ook ondervangen. Om na 10 minuten de boel op slot zetten lijkt mij niet erg zinvol. Het kan wel maar lijkt mij redelijk complex worden omdat je dan met bladbeveiliging en waarschijnlijk met meerdere timers moet gaan werken.

 

[Killerman1991]

Jou code werkt perfect, helemaal top. Ja ik dacht al dat het veel werk was en het is niet echt nodig, dus dan laat ik dat eruit.
Nou werkt alles wat ik erin wil hebben.

Super bedankt:thumb:

 

[VenA]

Graag gedaan.

Nb gebruik de reageerknop ipv te quoten. Dat houdt het geheel wat overzichtelijker.

 

[Killerman1991]

Heb mijn berichten aangepast