[EXCEL] creazione slot grafici, da lista appuntamenti

[Anthony47]

Bravi, avete fatto tutto senza di me...

Propongo comunque una versione basata su macro, che lavora sfruttando la colonna G del foglio LISTA.

Il codice della macro:

Codice: Seleziona tutto

Sub WDPlann()
Dim lSh As Worksheet, wPL As Worksheet, wArr, KInd As Long, K As Long
Dim cPlDt As Date, I As Long, J As Long, lList As Long, UBWA As Long
Dim fIt As Boolean, tLen, cCol As String, flDay As Long
'
Set lSh = Sheets("LISTA")                   '<<< Il foglio con la lista
'
If ActiveSheet.Name = "DAY" Then
    Set wPL = Sheets("DAY")                 '<<< Il foglio Giornaliero
    flDay = 1
Else
    Set wPL = Sheets("PLANNER_WEEK")        '<<< Il foglio Settimanale
End If
'
lList = lSh.Cells(Rows.Count, 1).End(xlUp).Row      'Lunghezza lista?
wArr = lSh.Range("A2").Resize(lList, 7).Value       'Copia Lista
UBWA = UBound(wArr, 1)
lList = wPL.Cells(Rows.Count, 1).End(xlUp).Row      'Lunghezza foglio pianificazione
For J = 0 To 60 Step 3          'Data in orizzontale
    If Not IsDate(wPL.Cells(1, 2 + J).Value) Then Exit For      'Se manca data, End
    KInd = 1
    'Cancella elenchi e colori:
    wPL.Range("B1").Offset(2, J).Resize(lList - 2, 3).Interior.Color = xlNone
    wPL.Range("B1").Offset(2, J).Resize(lList - 2, 3).ClearContents
    'Scansione Lista orari su Pianificazione:
    For I = 3 To lList
        cPlDt = wPL.Cells(I, 1).Value + wPL.Cells(1, 2 + J).Value   'Data /Ora di piano
        fIt = False
        For K = KInd To UBWA                                        'Scan della lista
            If wArr(K, 1) + wArr(K, 2) = cPlDt Then                 'Trovata Data /Ora
'                KInd = K
                fIt = True
                Exit For
            End If
        Next K
        'Se Trovato:
        If fIt Then
            wPL.Cells(I, 2 + J) = wArr(K, 5)
            wPL.Cells(I, 3 + J) = wArr(K, 4)
            If flDay > 0 Then wPL.Cells(I, 4 + J) = wArr(K, 6)
            tLen = Round(wArr(K, 7) / 15, 0): If tLen > 7 Then tLen = 7
            cCol = Application.WorksheetFunction.Dec2Bin(tLen, 3) & "000"
            wPL.Cells(I, 2 + J).Resize(tLen, 2 + flDay).Interior.Color = RGB(155 + 100 * CInt(Mid(cCol, 3, 1)), 155 + 100 * CInt(Mid(cCol, 2, 1)), 155 + 100 * CInt(Mid(cCol, 1, 1)))
        End If
    Next I
'Prossima colonna Data
Next J
End Sub


La macro agisce o sul foglio DAY oppure su PLANNER_WEEK, a seconda di quale foglio sia selezionato.
Va inserito in un Modulo standard del vba; le istruzioni marcate <<< vanno personalizzate come da commento

Poi va avviata la Sub WDPlann, che aggiornera' il planning secondo il contenuto del foglio LISTA e le date/ore contenute sul foglio di pianificazione.

Per avviare automaticamente la Sub WDPlann, e' conveniente aggiungere l'istruzione Call WDPlann in coda alle attuali Sub datameno7, Sub data7, Sub data1 e Sub datameno1 (aggiungere Call WDPlann subito prima di End Sub)

Inoltre si potrebbe eseguire automaticamente all'attivazione dei foglio DAY o PLANNER_WEEK; per questo, partendo da Excel:
-tasto dx sul tab col nome del foglio; scegliere Visualizza codice; inserire questo codice nella finestra vuota del vba che viene cosi' aperta:

Codice: Seleziona tutto

Private Sub Worksheet_Activate()
Call WDPlann
End Sub


-ripetere per l'altro foglio

La colorazione sara'
-verso il Rosso, per durata 15 min
-verso il Verde, per durata 30 min
-verso il Giallo, per durate ipotetiche di 45 min
-verso il Blu, per durate 60 min
-verso il Viola, per durate ipotetiche di 75 min
-verso il Celeste, per durate ipotetiche di 90 min
Oltre 90 min la colorazione viene disabilitata

Ciao

[marcus69]

Imbarazzante,
la soluzione di Anthony47 è qualcosa di spettacolare.

La sto provando e devo dire che fa dimenticare che si stia lavorando con EXCEl, lo porti a livello di DB relazionale con la programmazione !

[marcus69]

Ciao a tutti,
cosi come è stato impostato, soluzione di Anthony47 via macro, soluzione wallace&gromit via formattazione funziona perfettamente.

Ho impostato tutto con i nomi e con gli orari corretti ed è spettacolare.

Problema, venuto fuori stamane e mai pensato prima.

TC è un esame fatto in laboratorio separato, e quindi PUO' andare in sovrapposizione con RIAB e PEV

Le lettera A - B - D ( RIAB/PEV) , per intenderci, sono sempre nel medesimo laboratorio,
La lettera C (TC), è in un laboratorio differente e può essere sovrapposto al laboratorio RIAB

Quando ho lo stesso giorno, e lo stesso orario, MA PERSONA DIVERSA, ovviamente nella colonna formattata vedo solo una terapia.

Avevo pensato di creare una seconda colonna Terapia, e inserire esclusivamente la TC (c) in modo da visualizzare le due colonne dei due laboratori in parallelo.
Purtroppo non va bene, perché comunque il nome è diverso e ho una sola cella che con l'artifizio del trova verticale mette ( giustamente ) il primo che trova.

A questo punto, più che non sapere come fare. Non so cosa fare. Non ho proprio idea di come mostrare la cosa

Avete suggerimenti per cortesia? è un vero disastro da qualsiasi lato la si guardi, non se ne esce

[marcus69]

http://www.pcdata.it/upload18/ipo1.pdf


ecco più o meno credo che questa sia la soluzione a cui devo puntare , che ne pensate?


credo sia opportuno pensare a Lunedi e Martedì affiancati, e poi Mercoldi e Giovedì, se vado in questa direzione, altrimenti si allarga troppo...

[marcus69]

Sono arrivato fin qui, riesco a cercare nella matrice solo quelli che hanno "c" a destra?
e se non hanno "c" "non cercano e lasciano lo "slot" in bianco nella colonna TC

credo sarebbe la soluzione che ne pensate?


( click per immagine completa )
http://www.pcdata.it/upload18/ecco.png

[Anthony47]

Mi sembrava strano che non ci fossero sovrapposizioni possibili...

La mia proposta e' che fai pianificazioni diverse per gruppi di esami diversi:
A) Crei piu' fogli chiamati DAY_xx e PLANNER_WEEK_xx, con la struttura pari a quella per cui avevo sviluppato la Sub WDPlann. Tutti questi fogli conterranno il codice della Private Sub Worksheet_Activate (che ti avevo gia' dato)
B) In ognuno di questi fogli, da Z2 verso il basso crei l'elenco degli esami da prendere in considerazione; nel creare la pianificazione, la macro controllera' che la descrizione della Prestazione "contenga" una di quelle stringhe. Da quello che ho capito, in un foglio ci saranno RIAB, PEV (e forse altro) e nell'altro TC (e forse altro).

C) Sostituisci il codice della Sub WDPlann con quest'altro:

Codice: Seleziona tutto

Sub WDPlann()
Dim lSh As Worksheet, wPL As Worksheet, wArr, KInd As Long, K As Long
Dim cPlDt As Date, I As Long, J As Long, lList As Long, UBWA As Long
Dim fIt As Boolean, tLen, cCol As String, flDay As Long
Dim tArr
'
Set lSh = Sheets("LISTA")                   '<<< Il foglio con la lista
'
If Left(ActiveSheet.Name, 3) = "DAY" Then
    Set wPL = Sheets("DAY")                 '<<< Il foglio Giornaliero
    flDay = 1
ElseIf Left(ActiveSheet.Name, 12) = "PLANNER_WEEK" Then
    Set wPL = Sheets("PLANNER_WEEK")        '<<< Il foglio Settimanale
Else
    Beep
    Debug.Print ActiveSheet.Name
    Exit Sub
End If
'
lList = lSh.Cells(Rows.Count, 1).End(xlUp).Row      'Lunghezza lista?
wArr = lSh.Range("A2").Resize(lList, 7).Value       'Copia Lista
lList = wPL.Cells(Rows.Count, "Z").End(xlUp).Row      'Lunghezza lista "Tipi"
tArr = wPL.Range("Z2").Resize(lList + 3, 1).Value     'Copia Lista Tipi
UBWA = UBound(wArr, 1)
lList = wPL.Cells(Rows.Count, 1).End(xlUp).Row      'Lunghezza foglio pianificazione
For J = 0 To 60 Step 3          'Data in orizzontale
    If Not IsDate(wPL.Cells(1, 2 + J).Value) Then Exit For      'Se manca data, End
    KInd = 1
    'Cancella elenchi e colori:
    wPL.Range("B1").Offset(2, J).Resize(lList - 2, 3).Interior.Color = xlNone
    wPL.Range("B1").Offset(2, J).Resize(lList - 2, 3).ClearContents
    'Scansione Lista orari su Pianificazione:
    For I = 3 To lList
        cPlDt = wPL.Cells(I, 1).Value + wPL.Cells(1, 2 + J).Value   'Data /Ora di piano
        fIt = False
        For K = KInd To UBWA                                        'Scan della lista
            If wArr(K, 1) + wArr(K, 2) = cPlDt And TipoOk(wArr, K, tArr) Then                'Trovata Data /Ora, trovato Tipo
'                KInd = K
                fIt = True
                Exit For
            End If
        Next K
        'Se Trovato:
        If fIt Then
            wPL.Cells(I, 2 + J) = wArr(K, 5)
            wPL.Cells(I, 3 + J) = wArr(K, 4)
            If flDay > 0 Then wPL.Cells(I, 4 + J) = wArr(K, 6)
            tLen = Round(wArr(K, 7) / 15, 0): If tLen > 7 Then tLen = 7
            cCol = Application.WorksheetFunction.Dec2Bin(tLen, 3) & "000"
            wPL.Cells(I, 2 + J).Resize(tLen, 2 + flDay).Interior.Color = RGB(155 + 100 * CInt(Mid(cCol, 3, 1)), 155 + 100 * CInt(Mid(cCol, 2, 1)), 155 + 100 * CInt(Mid(cCol, 1, 1)))
        End If
    Next I
'Prossima colonna Data
Next J
End Sub


Function TipoOk(ByRef myArr, myInd As Long, ByRef Types) As Boolean
Dim I As Long, cType As String
'
'TipoOk = True: Exit Function
cType = myArr(myInd, 4)
For I = 1 To UBound(Types)
    If Types(I, 1) <> "" Then
        If InStr(1, cType, Types(I, 1), vbTextCompare) > 0 Then
            TipoOk = True
            Exit Function
        End If
    End If
Next I
End Function


Ci sono alcune modifiche nella Sub WDPlann, piu' la nuova Function TipoOk

D) Infine e' opportuno che negli stessi moduli vba in cui e' stato inserito il codice Private Sub Worksheet_Activate() /Call WDPlann /End Sub aggiungi questo ulteriore codice:

Codice: Seleziona tutto

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = Range("Z1").Column Then
    Call WDPlann
End If
End Sub


In questo modo la Sub WDPlann sara' eseguita anche tutte le volte che si cambia il contenuto della colonna Z

Ciao

[marcus69]

Ciao Antonhy grazie per la risposta.
Ieri sera quando è arrivata la tua risposta credevo di aver visto la luce. Purtroppo ho sopravvalutato la mia capacità di leggere VB.
Non girano le formule e mi da da errore.
Ti giuro che mi sono impegnato e ci ho provato.
Ho fatto tardissimo per riuscire.
Ora mi bevo un caffè e poi vado al lavoro.
Ti mando poi lo screenshot dell errore

Secondo te non e possibile risolverla solo con le funzioni di Excel classiche? Altrimenti non sarò in grado di metterci le mani se ci fossero problemi.

[marcus69]

Allora, ho appena finito di provare con le macro e il VB, non sono stato capace di venirne a capo.
Ho parzialmente risolto cosi:
ho sdoppiato la lista portando " fuori" le TC che sono l'unica terapia che rischia la sovrapposizione e creato una seconda matrice di ricerca sul modello della prima.

ora vedo come va per la formattazione.

[Anthony47]

ho appena finito di provare con le macro e il VB, non sono stato capace di venirne a capo

Se ti interessa disporre anche della soluzione "Macro", allora pubblica il file in cui hai fatto le prove e vderemo di capire perche' a te non funge.

Quanto al lavoro con le formule, sinceramente non ho seguito quella discussione, quindi non sono in grado di dare contributi al volo.

Se pero' non risolvi allora descrivi la situazione a cui sei arrivato (ed eventualmente un file di esempio, se quelli pubblicati non sono idonei) e vedremo...

[marcus69]

ciao,
oggi, al lavoro, ci stavo lavorando, in parallelo sia alla soluzione con le formule, che alla soluzione macro.
Una "quadra" è vicina, ma sto approfittando per imparare dal codice che hai postato, mi sta dando molti spunti.
Stasera dopo cena, posto il punto in cui sono e vediamo di capire.

grazie mille ad entrambi! siete fantastici

[marcus69]

purtroppo io e VBA non abbiam un buon rapporto ( con la programmazione in generale direi )

www.pcdata.it/upload18/nulla.mov

non succede più nulla. prima almeno avevo degli errori, adesso, lancio la Macro e non c'è nessuna formattazione

[Anthony47]

Dal filmino non si deduce nulla.
Forse se alleghi il file completo e descrivi a quale delle proposte che abbiamo fatto esso e' allineato, allora (forse) capiamo di piu'.
Chiarisci anche quale e' la tua piattaforma di lavoro, il tuo sistema operativo e la versione di Excel che usi

Ciao