evitare doppi assegnazioni in agenda

Question

ho un'agenda excel con in colonna A i clienti e nelle successive i giorni, in cui viene inserita la risorsa rappresentato da un colore di riempimento con motivo. Mi sono fatto con molta fatica perchè non esperto una routine che mi conta gli impegni di ogni risorsa sempre per il colore di riempimento. Ora mi piacerebbe avere modo, nel momento che inserisco il colore di una risorsa già impegnata in quel giorno, di ricevere un alert per evitare la sovrapposizione. Se può essere utile allego routine di conteggio (se poi è migliorabile.....)

Function cellsetting(InRange As Range, CellRange As Range) As Long
Dim cl As Range, TempCount As Long, ColorIndex As Long, pattern As Long, PatternColorIndex As Long

ColorIndex = CellRange.Cells(1.1).Interior.ColorIndex  
pattern = CellRange.Cells(1.1).Interior.pattern  
PatternColorIndex = CellRange.Cells(1.1).Interior.PatternColorIndex  
 

TempCount = 0
For Each cl In InRange
If ((cl.Interior.ColorIndex = ColorIndex And (cl.Interior.pattern = pattern And (cl.Interior.pattern <> xlPatternAutomatic Or cl.Interior.pattern <> xlPatternNone)) And cl.Interior.PatternColorIndex = PatternColorIndex)) Then
TempCount = TempCount + 1
Else: TempCount = TempCount
End If
Next cl

Set cl = Nothing  
  
cellsetting = TempCount  
  

End Function

grazie

Answer 1

Ciao Massimo,

https://1drv.ms/x/s!Ahjd5nHUaqHiiEXyCZVxMi52S3tk?e=1sjC6z ecco il link. praticamente io inserisco in corrispondenza di un lavoro e di una data il colore di una risorsa e vorrei che se in quella data la persona è già impegnata mi dia un alert.

Ti ricordo che i colori possono essere differenti per colore di riempimento, motivo ecolore del motivo

Penso che ci sia un problema intrinseco con il tuo approccio perché il cambiamento di colore (o motivo) di una cella non attiva un evento gestibile in Excel. Di conseguenza, non è possibile generare direttamente un avviso quando viene inserito o modificato un colore.

Suggerirei quindi un approccio diverso: invece di inserire un colore/motivo, inserisci un codice per ogni risorsa e crea un formato condizionale per ogni risorsa. Questo formato condizionale può inserire il colore/motivo desiderato e nascondere il codice imponendo un colore del carattere bianco.

In questo modo si possono ottenere gli avvisi richiesti come segue:

• Fai clic dx sulla linguetta del foglio Program
• Seleziona l'opzione Visualizza Codice dal **** menu contestuale risultante
• Incolla il seguente codice:

'========>>

Option Explicit

'-------->>

Private Sub Worksheet_Change(ByVal Target As Range)

Dim RngLavori As Range, Rng As Range, Rng2 As Range 

Const sRighe\_Lavori\_In\_Corso As String = "5:55" 

Set RngLavori = Me.Range(sRighe\_Lavori\_In\_Corso) 

Set Rng = Intersect(RngLavori, Target) 

If Not Rng Is Nothing Then 

Set Rng2 = Intersect(RngLavori, Target.EntireColumn) 

    If Application.CountIf(Rng2, Target.Value) > 1 Then 

        Call MsgBox(Prompt:="Attenzione ! La persona è già impegnata!", \_ 

            Buttons:=vbCritical, \_ 

            Title:="PROBLEMA") 

            Target.Select 

    End If 

End If 

End Sub

'<<========

Per quanto riguarda la tua funzione cellsetting, forse potresti provare la seguente versione modificata:

'-------->>

Public Function CellSetting(InRange As Range, CellRange As Range) As Long

Dim cl As Range 

Dim TempCount As Long, ColorIndex As Long, pattern As Long, PatternColorIndex As Long 

With CellRange.Cells(1).Interior 

    ColorIndex = .ColorIndex 

    pattern = .pattern 

    PatternColorIndex = .PatternColorIndex 

End With 

For Each cl In InRange.Cells 

    With cl.Interior 

        If .ColorIndex = ColorIndex \_ 

            And .pattern = pattern \_ 

            And .pattern <> xlPatternAutomatic \_ 

            And .pattern <> xlPatternNone \_ 

            And .PatternColorIndex = PatternColorIndex Then 

            TempCount = TempCount + 1 

        End If 

    End With 

Next cl 

 CellSetting = TempCount 

End Function

'<<========

===

Regards,

Norman

Answer 2

Ciao Massimo,

ho controllato dopo l'invio e ho visto che girando il file in Drive da sempre errore Name. ora non so come fare

Prova a caricare il file su Microsoft OneDrive o DropBox, e posta un link al file in una risposta qui.

Per caricare il file su Microsoft OneDrive, vedi:

   Condividere file e cartelle di OneDrive

Per caricare il file su DropBox, vedi:

Come faccio a condividere file e cartelle in Dropbox?

===

Regards,

Norman

Answer 3

ho controllato dopo l'invio e ho visto che girando il file in Drive da sempre errore Name. ora non so come fare

Answer 4

Ciao Massimo,

Scusami, ma nel ridurre le dimensioni del file non ho controllato che tutto funzionasse. ti mando il link al file funzionante.

[...] https://drive.google.com/file/d/1KvI3a91AEA4O4UMUbao5akEm0C8w6Gez/view?usp=sharing

Sfortunatamente, non ho i diritti per aprire il tuo file:

===

Regards,

Norman

Answer 5

Scusami, ma nel ridurre le dimensioni del file non ho controllato che tutto funzionasse. ti mando il link al file funzionante.

Comunque cellsetting ad es. cellsetting(K$5:K$54;$B56) controlla nell'intervallo indicato la presenza del colore $B56 nella data e segna 1 nell'elenco risorse (azzurro) e 2 o più (rosso o marrone) le assegnazioni multiple.

Il vantaggio del foglio sta nell'identificare ogni giorno le risorse libere scorrendo la colonna della data trovando gli 0

https://drive.google.com/file/d/1KvI3a91AEA4O4UMUbao5akEm0C8w6Gez/view?usp=sharing

grazie ancora