evidenziare dei turni

[raimea]

ciao
in un file di turni composto da piu fogli ,tramite macro, vorrei elaboralo
con alcuni accorgimenti x renderlo piu - leggibile-

i fogli sono composti da N righe e Y colonne diverse fra i vari fogli
quindi x prima cosa la macro dovrebbe trovare l'ultima riga e colonna in cui operare.
(la colonna iniziale attuale e' la I , ma varia ogni 5-6 mesi
quindi vorrei dichiararla nella macro x esteso se possibile)

nella riga 1 ci sono i gg della settimana
i turni da elaborare partono da riga 3 a step di 3 righe

ora vado a descrivere come vorrei modificare la grafica.

1) se nella riga 1 ci sono le sigle LMMGV
e il turno comprende LL / RI vorrei mette a LL/RI una cornice nera spessore medio

2) se nella riga 1 c'e il giorno S
e il turno e' B/1/2 vorrei mette una cornice nera spessore medio

3) se nella riga 1 c'e' il giorno D
e nel turno c'e la lettere B vorrei mette una cornice nera spessore medio


vi allego il file

https://www.dropbox.com/s/i3ob0vx0tdsrpvy/test.rar?dl=0

ciao

[klingklang]

Ciao, se l'unico obiettivo è formattare in automatico celle i cui valori sono già compilati, non è necessaria una macro: qualche regolina di formattazione condizionale dovrebbe essere più che adeguata allo scopo

[raimea]

ciao - klingklang

ovviamente lo so che e' possibile fare con la format condizionale !

ma come puoi immaginare dal nome del file, questo e' una parte del file e non quello finale.
P er altre ragioni , che non e' il caso stare a raccontare, non posso usare la formt. cond.

come da descrizione mi servirebbe farlo con macro.

ciao

[Anthony47]

Nel problema posto la rottura principale e' quella di ricostruire i bordi originali nel caso che nessuna delle evidenze sia da applicare…

Cio' detto, mi pare che questo codice applichi le evidenze dove dici e le toglie dove non vanno:

Codice: Seleziona tutto

Sub ShHighl()
Dim LastC As Long, LastR As Long, I As Long, FirstC As Long
Dim J As Long, WDArr, SatArr, SunArr, BordH As Boolean
'
WDArr = Array("LL", "RI")           '<<< Turni da evidenziare LMMGV
SatArr = Array("B", 1, 2, "1", "2") '<<< Turni da evidenziare il Sab
SunArr = Array("B")                 '<<< Turni da evidenziare la Dom
'
LastC = Cells(2, Columns.Count).End(xlToLeft).Column
FirstC = Application.Match(Application.WorksheetFunction.Min(Range("A2").Resize(1, LastC)), Range("A2").Resize(1, LastC), False)
LastR = Cells(Rows.Count, "D").End(xlUp).Row
'
If IsError(FirstC) Then
    MsgBox ("Non riesco a identificare la colonna di inizio date, processo terminato")
    Exit Sub
End If
For I = 3 To LastR
    For J = FirstC To LastC
        BordH = False
        If Cells(I, J) = "" Then Exit For
        If Application.WorksheetFunction.Weekday(Cells(2, J), 2) < 6 Then   'LMMGV
            If Not IsError(Application.Match(Cells(I, J), WDArr, False)) Then BordH = True
        ElseIf Application.WorksheetFunction.Weekday(Cells(2, J), 2) = 6 Then  'Sab
            If Not IsError(Application.Match(Cells(I, J), SatArr, False)) Then BordH = True
        ElseIf Application.WorksheetFunction.Weekday(Cells(2, J), 2) = 7 Then  'Dom
            If Not IsError(Application.Match(Cells(I, J), SatArr, False)) Then BordH = True
        End If
'        Cells(I, J).Select
        cippa = RHL(Cells(I, J), BordH)
    Next J
Next I
MsgBox ("Completato...")
End Sub

Function RHL(ByRef myRan As Range, ByVal HL As Boolean)
Dim StdStyle, StdWeight, LeftS, RightS

If HL Then
    StdStyle = xlContinuous
    StdWeight = xlMedium
    LeftS = xlContinuous
    RightS = xlContinuous
Else
    StdStyle = xlNone
    StdWeight = xlThin
    If Application.Weekday(Cells(2, myRan.Column), 2) = 1 Then LeftS = xlContinuous Else LeftS = xlNone
    If Application.Weekday(Cells(2, myRan.Column), 2) = 7 Then RightS = xlContinuous Else RightS = xlNone
End If

    myRan.Borders(xlDiagonalDown).LineStyle = xlNone
    myRan.Borders(xlDiagonalUp).LineStyle = xlNone
    If HL Then
        With myRan.Borders(xlEdgeLeft)
            .Weight = StdWeight
            .TintAndShade = 0
            .Color = 0
            .LineStyle = LeftS
        End With
    End If
    With myRan.Borders(xlEdgeTop)
        .Weight = StdWeight
        .TintAndShade = 0
        .Color = 0
        .LineStyle = xlContinuous
    End With
    With myRan.Borders(xlEdgeBottom)
        .Weight = StdWeight
        .TintAndShade = 0
        .Color = 0
        .LineStyle = StdStyle
    End With
    With myRan.Borders(xlEdgeRight)
        .Weight = StdWeight
        .Color = 0
        .TintAndShade = 0
        .LineStyle = RightS
    End With
    myRan.Borders(xlInsideVertical).LineStyle = xlNone
    myRan.Borders(xlInsideHorizontal).LineStyle = xlNone
End Function


La macro da avviare e' la ShHighl, che lavorera' sul foglio corrente.
Non e' particolarmente veloce, perche' lavora sull'intera area dei turni e perche' la formattazione in sé non e' per niente veloce. D'altra parte immagino che la eseguirai solo sul ricalcolo dei turni, cioe' di tanto in tanto.

Le colonne su cui lavorare sono calcolate con le istruzioni

Codice: Seleziona tutto

LastC = Cells(2, Columns.Count).End(xlToLeft).Column
FirstC = Application.Match(etc etc)
LastR = Cells(Rows.Count, "D").End(xlUp).Row


Nulla vieta che FirstC (prima colonna) sia invece impostata a mano come valore costante.

Ciao

[raimea]

ciao
e' tutto OK
------

Nel problema posto la rottura principale e' quella di ricostruire i bordi originali nel caso che nessuna delle evidenze sia da applicare…

di questo non ci avevo proprio pensato.

Non e' particolarmente veloce, perche' lavora sull'intera area dei turni e perche' la formattazione in sé non e' per niente veloce. D'altra parte immagino che la eseguirai solo sul ricalcolo dei turni, cioe' di tanto in tanto.

x la velocita nessun problema anche se per le mie esigenze e' più che veloce
Si, dovro' farla girare solo 3 Max 4 volte in un anno.

ancora GRAZIE

ciao