compilare un foglio annuale

[raimea]

ciao

tramite macro vorrei compilare il foglio anno
prelevando dati da 2 fogli
nel fgl anno , il giorno e' scritto in riga 4 da F4
mentre in col E5 ho i 12 mesi.

da fgl ef :
prendere le date da col C6
e riempire la relativa casella di fgl anno
scrivendoci ef con sfondo blu.

da fgl ferie:
prendere le date DA Col G6 : H6
e riempire le relative celle di fgl anno
scrivendoci fe con sfondo verde

in questo caso delle ferie, si deve prestare attenzione
che non vengano riempite/considerate, le caselle relative
alle date della tabella festivita, infatti il num di caselle
da riempire e' indicato correttamente in Col J
cosi come i giorni di sabato_domenica , non devono essere riempiti con >> fe

da fgl ferie:
prendere le date DA Col K24
e riempire le relative celle di fgl anno
scrivendoci X con sfondo marrone_chiaro

non so se e' possibile compilare il fgl anno
cosi impostato.

vi allego il file
https://www.dropbox.com/s/0irbhake9zgapdn/anno.rar?dl=0


grazie , ciao

[Anthony47]

Credo he questo codice faccia il lavoro:

Codice: Seleziona tutto

Sub CompilaAnno()
Dim aDest As Range, aFestiv As Range, aEF As Range, aSol As Range, aFerie As Range
'
'IMPOSTAZIONI:
Set aDest = Sheets("anno").Range("F5")
Set aFestiv = Sheets("ferie").Range("P7")
Set aEF = Sheets("EF").Range("C6")
Set aSol = Sheets("ferie").Range("K24")
Set aFerie = Sheets("ferie").Range("G6")
'
'PULISCE L'AREA DI DESTINAZIONE:
aDest.Resize(12, 31).ClearContents
aDest.Resize(12, 31).Interior.Color = xlNone
'
'COMPILA:
Call SetInfo(aEF, "ef", RGB(150, 150, 250), aDest)
Call SetInfo(aSol, "X", RGB(150, 140, 60), aDest)
Call SetFerie(aFerie, "FE", RGB(150, 250, 150), aDest, aFestiv)
MsgBox ("Completato...")
End Sub


Sub SetInfo(ByVal StArea As Range, ByVal Sigla As String, ByVal bgCol As Long, ByRef dArea As Range)
Dim I As Long, ccDate
'
'SOL ED EF
For I = 1 To 1000
    ccDate = StArea.Cells(I, 1).Value
    If ccDate <> "" Then
        cday = Day(ccDate)
        cmon = Month(ccDate)
        dArea.Offset(cmon - 1, cday - 1).Value = Sigla
        dArea.Offset(cmon - 1, cday - 1).Interior.Color = bgCol
    Else
        Exit For
    End If
Next I
End Sub

Sub SetFerie(ByVal StArea As Range, ByVal Sigla As String, ByVal bgCol As Long, ByRef dArea As Range, ByRef Holid As Range)
Dim I As Long, ccDate, J As Long
'
'FERIE
For I = 1 To 1000
    ccDate = StArea.Cells(I, 1).Value
    If ccDate <> "" Then
        For J = ccDate To StArea.Cells(I, 2).Value
            If Weekday(J, vbMonday) < 6 Then
                If IsError(Application.Match(J, Holid.Resize(100, 1), False)) Then
                    cday = Day(J)
                    cmon = Month(J)
                    dArea.Offset(cmon - 1, cday - 1).Value = Sigla
                    dArea.Offset(cmon - 1, cday - 1).Interior.Color = bgCol
                End If
            End If
        Next J
    Else
        Exit For
    End If
Next I
End Sub


Devi lanciare la Sub CompilaAnno
All'inizio la macro cancella le informazioni presenti nel tabellone annuo; se invece prefrisci lavorare AGGIUNGENDO dati a quelli preesistenti allora devi eliminare le due istruzioni che come commento hanno PULISCE L'AREA DI DESTINAZIONE

Ciao

[raimea]

ciao
Ottimo !!

perfetta ,
usero ' l 'opzione che il tabellone viene pulito e ricreato ogni volta

grazie