riempimento automatico di piu celle settimanali in calendario dinamico

[marco_budinPartecipante marco_budin Karma: 2 pts]

buongiorno,

ho un file dove viene rappresentato in maniera dinamica il mese di gennaio. Nel senso che se cambio gli anni sheets("Home").Range("d4") , cambiano le evidenziazioni dei weekend/ festivi/ giorni.

vorrei automatizzare l'autocompilazione della tabella: i turni dei medici della notte sono settimanli e durano 7 giorni e cominciano da venerdì e terminano di giovedì (compresi). io vorrei scegliere dalla tendina il medico che fa il venerdì dalla colonna sheets("gennaio").Range("g12:g42") e in automatico si compilano gli altri campi fino a giovedì compreso con la stessa sigla. Cioè se lo facessi fisso per il 2019.. farei una formula... ma il problema è che l'anno seguente il venerdì è in un altra cella... e quindi la formula non funzionerebbe più. 

invece per la colonna sheets("gennaio").Range("h12:h42") i medici lavorano solo il weekend (2giorni), quindi io riempio il sabato... e in automatico mi mette la domenica.

invece per la colonna sheets("gennaio").Range("i12:i42")  i medici lavorano 3 giorni, quindi io inserisco il medico al venerdì... e lui compila sabato e domenica (3 giorni in totale)...

come posso fare?? ce qualcuno che potrebbe aiutarmi? qui dovrò sicuramente andare sul vba...

vi ringrazio anticipatamente come sempre, e vi auguro una buona serata!

saluti e a presto

Marco

Allegati:

You must be logged in to view attached files.

[albatros54Moderatore albatros54 Karma: 89 pts]

Questo è solo uno spunto.applica alla colonna "G" convalida dati inserendo questo percorso=DATABASE!$A$41:$A$56

, incolla il codice che ti  posto nel foglio "gennaio" inserisci in qualche cella della colonna "G" il nome di qualche medico, prova e fai sapere

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rgintervallo As Range
    Dim strgiorno As String

    Application.EnableEvents = False
    Set rgintervallo = Range("g12:g42")
    If Not Intersect(Target, rgintervallo) Is Nothing Then
        MsgBox " intersecato"
        strgiorno = Target.Offset(, -1)
        strgiorno= Format(strgiorno, "ddd")
        If strgiorno = "ven" Then
            Target.Copy Target.Resize(7, 1)
        End If
    End If
    Application.EnableEvents = True
End Sub

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

[marco_budinPartecipante marco_budin Karma: 2 pts]

ciao Albatros,

grazie mille della tua pronta risposta. ho provato a fare quello che mi hai detto... ma non si autocompila... nel senso ho provato a mettere nella colonna G di venerdi DEF dalla tendina, ma non mi riempie in automatico tutta la settimana fino a giovedì dopo.

ti riallego il file.

ti ringrazio

saluti

Marco

Allegati:

You must be logged in to view attached files.

[albatros54Moderatore albatros54 Karma: 89 pts]

Ho scaricato il tuo file,Funziona!! riempe le celle che vanno da Ven a Gio, prova di nuovo, magari commenta la riga di codice della msgbox, quando modifichi la cella devi dare un Return

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

[marco_budinPartecipante marco_budin Karma: 2 pts]

ciao Albatros! 🙂 si hai ragione adesso funziona... si vede che avevo disabilitato qualcosa! è fantastico...  sei come sempre un grande!

ho adeguato la formula alle altre 3 colonne, G,H,I... comunque nasce un problema.. come rivedi nell'esempio che ti ho ri-allegato, ho messo l'anno 2018, il venerdì è 26.1.2018, e quando seleziono il venerdì per farlo riempire di 7 giorni... esce dal mese... chiaramente lui non sa che deve fermarsi al 31... cè un modo per non farlo uscire? cioè dovrebbe alla fine adeguarsi al mese..

ho provato ad inserire alla fine del codice il cancella righe... ma mi fa andare in palla l'excel... 21.3.xlsm

Rows("43:50").Delete Shift:=xlUp

ti auguro una buona serata e ti ringrazio come sempre!!

marco

Allegati:

You must be logged in to view attached files.

[marco_budinPartecipante marco_budin Karma: 2 pts]

ciao Albatros! sono riuscito... dovevo mettere il cancella prima dell'Application.Enable.... 🙂

posto il codice che funziona:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rgintervallo As Range
    Dim rgintervallo1 As Range
    Dim strgiorno As String
    Dim strgiorno1 As String

    Application.EnableEvents = False
    Set rgintervallo = Range("g12:g42")
    If Not Intersect(Target, rgintervallo) Is Nothing Then
        strgiorno = Target.Offset(, -1)
        strgiorno = Format(strgiorno, "ddd")
        If strgiorno = "ven" Then
            Target.Copy Target.Resize(7, 1)
        End If
    End If
    Range("F43:AE49").Delete Shift:=xlToLeft
    Application.EnableEvents = True
    
    Application.EnableEvents = False
    Set rgintervallo1 = Range("i12:i42")
    If Not Intersect(Target, rgintervallo1) Is Nothing Then
        strgiorno1 = Target.Offset(, -3)
        strgiorno1 = Format(strgiorno1, "ddd")
        If strgiorno1 = "ven" Then
            Target.Copy Target.Resize(3, 1)
        End If
    End If
    Range("F43:AE49").Delete Shift:=xlToLeft
    Application.EnableEvents = True
    
    Application.EnableEvents = False
    Set rgintervallo2 = Range("h12:h42")
    If Not Intersect(Target, rgintervallo2) Is Nothing Then
        strgiorno2 = Target.Offset(, -2)
        strgiorno2 = Format(strgiorno2, "ddd")
        If strgiorno2 = "sab" Then
            Target.Copy Target.Resize(2, 1)
        End If
    End If
    Range("F43:AE49").Delete Shift:=xlToLeft
    Application.EnableEvents = True
    

    
End Sub

ti ringrazio davvero infinitamente per l'aiuto che mi hai dato come sempre!

saluti e alla prossima...

Marco

[Autore]

Articoli