• 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.

getal op kalender laten verschijnen

Status
Niet open voor verdere reacties.

Spiesse

Gebruiker
Lid geworden
14 jul 2011
Berichten
902
Beste forumisten,

in bijlage een bestandje waar ik nog 1 klein dingetje in zou wensen...

ik heb al posts gemaakt hieromtrent, maar wegens geen reacties (en zelf opgelost) heb ik deze gesloten...

Ik hoop dat deze post iets eenvoudiger is...

In het bestand zie je op blad2 een kalender die automatisch wordt gekleurd adhv de data op blad 1. Via een formule in de voorwaardelijke opmaak lukt dit zonder problemen.

wat ik nu zou willen is het volgende:

- kan de celinhoud naast iedere cel op blad 1.range(a:a) ingevoegd worden op blad2 in de kalender?

in het bestand heb ik een voorbeeldje uitgewerkt. Graag zou ik dit indien mogelijk via vba in orde krijgen...

Ik ben benieuwd of er iemand een helpende hand heeft voor de maandag :)

groeten en alvast bedankt!
spiesse

Bekijk bijlage KALENDER KLEUREN EV.xlsx
 
Doe eens een paar testen met deze:

Code:
Sub cobbe()
 For Each cl In Sheets("Blad1").Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
    dag = Val(Left(cl, 2))
      maand = Val(Mid(cl, 4, 2))
        uren = cl.Offset(0, 1)
   Cells(maand + 5, dag + 2) = uren
 Next
End Sub
 
deze lukt cobbe!

maar... deze zou automatisch achter x aantal tabbladen moeten gestoken worden...

hoe zou ik dit aanpakken?

maar de code doet wel wat moet denk ik :)

gegroet!
spiesse
 
Hang het dan zo achter Blad1 :
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A:B")) Is Nothing Then Exit Sub
For Each cl In Sheets("Blad1").Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
    dag = Val(Left(cl, 2))
      maand = Val(Mid(cl, 4, 2))
        uren = cl.Offset(0, 1)
   Sheets("Blad2").Cells(maand + 5, dag + 2) = uren
 Next
End Sub
 
oki cobbe, doe ik!

een uitbreidinkje: alle cellen vroeger dan 1/9/2012 moeten weg uit de kolom... in het voorbeeld staan er nu wel geen data van voor 1/9/2012 maar dit kan wel voorkomen :)
 
Ik snap niet wat dit in deze macro moet doen, je zou dit toch beter in een aparte code verwerken. maar deze haalt eerst alle datums weg die ouder zijn dan 01/09/2012:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A:B")) Is Nothing Then Exit Sub
For Each cl In Sheets("Blad1").Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
   If cl < 41153 Then cl.EntireRow.Delete Shift:=xlUp
Next
For Each cl In Sheets("Blad1").Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
    dag = Val(Left(cl, 2))
      maand = Val(Mid(cl, 4, 2))
        uren = cl.Offset(0, 1)
   Sheets("Blad2").Cells(maand + 5, dag + 2) = uren
 Next
End Sub
 
cobbe,

ik probeer een groot bestand uit te werken via kleine wegjes :)
daarmee dat ik vraag hoe de data <1/9/2012 te deleten via de kalender...
in mijn groot bestand staat de kalender naast de reeks data, en daaruit moeten dan de data < 1/9/2012 verwijderd worden.
als ik het in de bronlijst doe is dit al een groot deel weg :)
 
Als die kalender naast de gegevenstabel staat lukt die code niet want die vernietigt ook uw kalender.
Deze doet dat niet:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A:B")) Is Nothing Then Exit Sub
For Each cl In Sheets("Blad1").Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
   If cl < 41153 Then Range("A" & cl.Row & ":B" & cl.Row).Delete Shift:=xlUp
Next
For Each cl In Sheets("Blad1").Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
    dag = Val(Left(cl, 2))
      maand = Val(Mid(cl, 4, 2))
        uren = cl.Offset(0, 1)
   Sheets("Blad2").Cells(maand + 5, dag + 2) = uren
 Next
End Sub
 
Bekijk bijlage test EV met macro's.xlsmcobbe,
ik ga voor uw en mijn gemak :) het bestand es als bijlage voegen...

bekijk je het eens?

via de knop op blad 1 worden bepaalde macro's na elkaar uitgevoerd...

De bedoeling is dat iedereen die verlof heeft opgenomen na 1/9/2012 automatisch de uren ziet verschijnen op zijn of haar tabblad in de kalender...

Enkel die laatste stap (uw macro om de getallen in de cellen te plaatsen) wil nog niet auto lukken...

kan jij dit es bekijken? ook merk ik dat er af en toe es een foutje in deze macro kruipt, zijnde: getallen worden boven de kalender ingevuld...
 
Doe eens een paar testen met deze:

Code:
Sub cobbe()
 For Each cl In Sheets("Blad1").Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
    dag = Val(Left(cl, 2))
      maand = Val(Mid(cl, 4, 2))
        uren = cl.Offset(0, 1)
   Cells(maand + 5, dag + 2) = uren
 Next
End Sub

ik vrees dat ik gevonden heb waar de bug zit... ale ja, bug...

als een datum in de eerste 9 dagen van de maand valt, dan wordt de waarde ergens bovenaan in de kalender geplaatst, tussen de gegevens...

mss een if die nodig is ergens?

groeten
spiesse
 
Cobbe,

goedemorgen.

Ik heb de code zelf kunnen aanpassen. Het was dus idd zo dat als een datum in de eerste 9 dagen van een maand viel, dat de uren ergens in de hoofding geschreven werden. Dit is opgelost nu.

Code:
Sub cobbe()

For Each cl In ActiveSheet.Range("b2:b" & Range("b" & Rows.Count).End(xlUp).Row)
    Dim temp As String
    temp = cl.Value
    If Len(temp) = 9 Then
        temp = 0 & temp
    End If
    
    dag = Val(Left(temp, 2))
    maand = Val(Mid(temp, 4, 2))
    uren = cl.Offset(0, 1)
    
   Cells(maand + 4, dag + 9) = uren
   
 Next
End Sub

Nu zou ik eventueel nog het volgende willen: deze code zou op alle bladen moeten lopen, beginnende van sheet 5 tot laatste sheet... Ik heb al bepaalde dingen geprobeerd maar lukt nog niet helemaal...

Code:
dim i as integer

i= 5 to sheets.count

enz...

lukt me niet om deze samen te stellen...

a little help is welcome :)

spiesse
 
cobbe,
ik heb terug het probleem als ik het bestand open dat het zogezegd beschadigd is... hoe komt da toch :) :) :)
kan je het in een ander formaat doorsturen indien mogelijk?

gracias!
 
cobbe, ik denk dat het nu bij mij ligt... iets met de temp/part die niet kan opgeslagen worden of teen of tander...

kan je het bestand alleen doorsturen, zonder een link naar mijnbestand? mss wordt die site geblokkeerd hier intern op het werk door de IT afdeling...

nogmaals mijn nederige excuses :)
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan