Vota | Stampa | Notifica email     « Discussione Precedente | Lista | Discussione Successiva »
Autore

messaggio di errore con due celle piene

Ultimo Aggiornamento: 21/06/2020 09:46
trittico69
Post: 193
Registrato il: 02/04/2010
Città: MILANO
Età: 54
Utente Junior
2002
OFFLINE
23/12/2017 13:02
00#61
dodo mi dovresti dire dove devo mettere il tuo codice perchè non so come va inserito.
perchè ho provato ad inserire un nuovo modulo e in this workbook mettendo il codice cosi modificato

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If ActiveSheet.Name <> "RIEP" And ActiveSheet.Name <> "codici servizi" Then


Dim R As Long
R = Target.Row

If Not Intersect(Target, [I14:I60]) Is Nothing Then
If Range("I" & R) = 2 Or Range("I" & R) = 3 Or Range("I" & R) = 4 Then
MsgBox "qui va messo solo codice presenza"
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
End If
End If



' questo codice ti da un messaggio di errore se per sbaglio metti riposo lo stesso giorno che hai lavorato
If Intersect(Target, Uni0n(Range("C14:C60"), Range("J14:J60"))) Is Nothing Then Exit Sub
Select Case Target.Column
Case 3
If Range("J" & R) <> "" Then

MsgBox "Non puoi scrivere in questa cella se colonna J non è vuota"
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
Exit Sub
End If
Case 10
If Range("C" & R) <> "" Then

MsgBox "Non puoi scrivere in questa cella se colonna C non è vuota"
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
Exit Sub
End If
End Select

End Sub



ma non funziona
grazie
[Modificato da trittico69 23/12/2017 14:48]
excel 2003
rollis13
Post: 621
Registrato il: 16/08/2015
Città: CORDENONS
Età: 67
Utente Senior
Excel 2016-32bit Win11
OFFLINE
23/12/2017 16:24
00#62
Non potendo prevedere tutte le possibili combinazioni di Copia/Incolla da ammettere ho presunto che sia utile gestire anche la colonna B considerato che molte altre colonne non prevedono ulteriori controlli per permettere un Copia/Incolla limitato, pertanto, mettendo in pratica anche l'indicazioni di dodo47 (unica macro per tutti i fogli) suggerisco di aggiungere al Select Case anche il controllo della colonna B.
Basta sostituire in questa riga:

'Case 3
Case 2, 3

e per comodità allego l'intero file aggiornato.

______________________________________________________________
C'è chi fa le COSE a CASO e chi fa CASO alle COSE (Ignoto)
trittico69
Post: 194
Registrato il: 02/04/2010
Città: MILANO
Età: 54
Utente Junior
2002
OFFLINE
26/12/2017 14:52
00#63
ho scaricato il tuo file ma il codice non funziona in nessuna delle condizioni...come se non ci fosse e comunque a questo codice si dovrebbe escludere oltre al foglio "riep" anche il foglio "codici servizi".
invece ho provato ad aggiungere case 2,3 al foglio di dicembre nel file che ho io e funziona.
nel frattempo se sei cosi gentile da farmi anche questo:
Se la cella A14 è colorata (o non è bianca) e J14 <>3 devo visualizzare un messaggio “in questa cella puoi scrivere solo 3”
Il codice va da A14:A56 e J14:J56
[Modificato da trittico69 26/12/2017 15:01]
excel 2003
rollis13
Post: 623
Registrato il: 16/08/2015
Città: CORDENONS
Età: 67
Utente Senior
Excel 2016-32bit Win11
OFFLINE
26/12/2017 23:43
00#64
Re:
trittico69, 26/12/2017 14.52:
comunque a questo codice si dovrebbe escludere oltre al foglio "riep" anche il foglio "codici servizi".
E' già previsto che tali fogli non vengano considerati; ma al codice proposto non ci dai nemmeno un'occhiata ??!! già il fatto che tu dica semplicemente "il codice non funziona" è deludete, non pensi che chi ti propone del codice non abbia perso anche tempo per collaudarlo ?? almeno un'indicazione di errore sarebbe comunque gradita; non abbiamo la sfera di cristallo.

Questa è la nuova versione della macro che comprende anche il controllo della colonna A se colorata.
E' l'unica macro da inserire per tutti i fogli e va inserita nel modulo "ThisWorkbook" (Questa_cartella_di_lavoro) così com'era nell'ultimo mio allegato. 

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    Dim R As Long
    
    If ActiveSheet.Name <> "RIEP" And ActiveSheet.Name <> "codici servizi" Then     'escluso questi fogli
        R = Target.Row
        ' questo codice ti segnala con un messaggio se per sbaglio scrivi riposo nella colonna "I" con il codice 2-3-4
        If Not Intersect(Target, [I14:I57]) Is Nothing Then
            If Range("I" & R) = 2 Or Range("I" & R) = 3 Or Range("I" & R) = 4 Then
                MsgBox "Qui va messo solo codice presenza"
                Application.EnableEvents = False
                Target.ClearContents
                Application.EnableEvents = True
            End If
        End If
        ' questo codice ti da un messaggio di errore se per sbaglio metti riposo lo stesso giorno che hai lavorato
        If Intersect(Target, Uni0n(Range("C14:C57"), Range("J14:J57"))) Is Nothing Then Exit Sub
        Select Case Target.Column
            Case 2, 3
                If Range("J" & R) <> "" Then
                    MsgBox "Non puoi scrivere in questa cella se colonna J non è vuota"
                    Application.EnableEvents = False
                    Target.ClearContents
                    Application.EnableEvents = True
                    Exit Sub
                End If
            Case 10
                If Range("C" & R) <> "" Then
                    MsgBox "Non puoi scrivere in questa cella se colonna C non è vuota"
                    Application.EnableEvents = False
                    Target.ClearContents
                    Application.EnableEvents = True
                    Exit Sub
                ' se colonna A è colorata in questa cella puoi scrivere solo 3
                ElseIf Range("A" & R).DisplayFormat.Interior.ColorIndex <> xlColorIndexNone And Target <> 3 Then
                    MsgBox "Puoi scrivere solo 3 se colonna A è colorata"
                    Application.EnableEvents = False
                    Target.ClearContents
                    Application.EnableEvents = True
                    Exit Sub
                End If
        End Select
    End If
    
End Sub





______________________________________________________________
C'è chi fa le COSE a CASO e chi fa CASO alle COSE (Ignoto)
trittico69
Post: 195
Registrato il: 02/04/2010
Città: MILANO
Età: 54
Utente Junior
2002
OFFLINE
27/12/2017 10:11
00#65

rollis innanzitutto grazie per il tempo che mi stai dedicando, ma il file che tu mi hai allegato, come gia detto nel post precedente, semplicemente non funziona, non mi da nessun errore.
comunque adesso sembra andare tutto bene...se nel tempo esce qualche problema ti faccio sapere.
[Modificato da trittico69 27/12/2017 10:38]
excel 2003
trittico69
Post: 196
Registrato il: 02/04/2010
Città: MILANO
Età: 54
Utente Junior
2002
OFFLINE
07/01/2018 15:04
00#66
rollis non funzionano piu le formule in F10:H10
puoi darmi una mano?
è collegato al codice nel modulo 2
forse c'è qualche incompatibilità con gli ultimi codici inseriti
come se il codice fosse stato cancellato , non da nessun tipo di errore
grazie
[Modificato da trittico69 07/01/2018 15:32]
excel 2003
rollis13
Post: 631
Registrato il: 16/08/2015
Città: CORDENONS
Età: 67
Utente Senior
Excel 2016-32bit Win11
OFFLINE
07/01/2018 17:30
00#67
No, quelle celle vengono compilate/aggiornate dalla macro "minuti" e la loro mancata compilazione non ha nulla a che fare con il codice della macro "Private Sub Workbook_SheetChange" su cui ci siamo concentrati negli ultimi post.
Tutto quello che posso intuire che c'è qualcosa (fin dall'inizio) che non quadra nei conteggi nelle colonne nascoste colonne P:AI dove vi sono i conteggi che poi serviranno alla macro "minuti" per riportare i totali rielaborati nelle celle F10:H10.

Non potendo visionare il tuo file attuale, a naso, posso affermare con certezza, visto l'ultimo file che ho allegato dove ho fatto un sacco di pulizia, che potrebbe mancare il richiamo alla macro "minuti" che in precedenza si trovava in ogni foglio:
Private Sub Worksheet_Calculate()
    Call minuti
End Sub

Se così non fosse faccio un'altra considerazione sempre per intuito.

Quello che sicuramente non hai implemento da quando hai protetto i foglio è lo sblocco della protezione all'inizio della macro principale e successivo blocco prima del termine della macro.
Dovrai, pertanto, inserire in testa alla macro "minuti" subito dopo la dichiarazione delle variabili questo codice:
ActiveSheet.Unprotect

e prima dell' "End Sub" il codice:
ActiveSheet.Protect

Ed ancora, vedo che all'inizio della macro "minuti" nel mio file c'è un refuso ma forse non è stato preso in considerazione. Eventualmente, il codice:
Application.EnableEvents = True
mentre per disattivare il controllo degli eventi dovrebbe essere:
Application.EnableEvents = False

Detto questo credo che ora il richiamo alla macro "minuti" possa tolta da ogni foglio ed essere integrata nella macro "Private Sub Workbook_SheetChange" mettendo il richiamo in fondo prima dell' "End Sub" riscrivendo il codice così:
Option Explicit
 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
 
    Dim R As Long
     
    If ActiveSheet.Name <> "RIEP" And ActiveSheet.Name <> "codici servizi" Then     'escluso questi fogli
        R = Target.Row
        ' questo codice ti segnala con un messaggio se per sbaglio scrivi riposo nella colonna "I" con il codice 2-3-4
        If Not Intersect(Target, [I14:I57]) Is Nothing Then
            If Range("I" & R) = 2 Or Range("I" & R) = 3 Or Range("I" & R) = 4 Then
                MsgBox "Qui va messo solo codice presenza"
                Application.EnableEvents = False
                Target.ClearContents
                Application.EnableEvents = True
            End If
        End If
        ' questo codice ti da un messaggio di errore se per sbaglio metti riposo lo stesso giorno che hai lavorato
        If Intersect(Target, Uni0n(Range("C14:C57"), Range("J14:J57"))) Is Nothing Then GoTo fine     'cambiata
        Select Case Target.Column
            Case 2, 3
                If Range("J" & R) <> "" Then
                    MsgBox "Non puoi scrivere in questa cella se colonna J non è vuota"
                    Application.EnableEvents = False
                    Target.ClearContents
                    Application.EnableEvents = True
                    Exit Sub
                End If
            Case 10
                If Range("C" & R) <> "" Then
                    MsgBox "Non puoi scrivere in questa cella se colonna C non è vuota"
                    Application.EnableEvents = False
                    Target.ClearContents
                    Application.EnableEvents = True
                    Exit Sub
                ' se colonna A è colorata in questa cella puoi scrivere solo 3
                ElseIf Range("A" & R).DisplayFormat.Interior.ColorIndex <> xlColorIndexNone And Target <> 3 Then
                    MsgBox "Puoi scrivere solo 3 se colonna A è colorata"
                    Application.EnableEvents = False
                    Target.ClearContents
                    Application.EnableEvents = True
                    Exit Sub
                End If
        End Select
    End If
fine:                'aggiunta
    Call minuti      'aggiunta
    
End Sub


______________________________________________________________
C'è chi fa le COSE a CASO e chi fa CASO alle COSE (Ignoto)
trittico69
Post: 197
Registrato il: 02/04/2010
Città: MILANO
Età: 54
Utente Junior
2002
OFFLINE
27/01/2018 13:28
00#68
ciao rollis rieccomi...non ho avuto il tempo di fare le modifiche che mi hai suggerito e che farò...ma prima ho riscontrato alcuni errori...se potresti aiutarmi...
se cancello il 3 da j14 mi esce il messaggio “puoi scrivere solo 3”(non dovrebbe uscire nulla visto che non ho scritto nessun numero)
se cancello 3 e 4 contemporaneamente in j14 e j15 selezionando entrambe le celle mi da errore a questa riga
ElseIf Range("A" & R).DisplayFormat.Interior.ColorIndex <> xlColorIndexNone And Target <> 3 Then
Se copio j14 e j15 e li incollo nel foglio “feb” con le stesse coordinate mi da errore sempre alla riga
ElseIf Range("A" & R).DisplayFormat.Interior.ColorIndex <> xlColorIndexNone And Target <> 3 Then

ti riallego il file
excel 2003
rollis13
Post: 637
Registrato il: 16/08/2015
Città: CORDENONS
Età: 67
Utente Senior
Excel 2016-32bit Win11
OFFLINE
27/01/2018 20:04
00#69
Bisogna rivedere le condizioni previste dal Case 10 in modo da evitare l'esecuzione della macro in caso di cella vuota.
Per quanto riguarda la gestione di più celle non c'è niente da fare in questi casi in cui si usa una macro che agisce in modo molto mirato. Bisogna nuovamente applicare quanto ti avevo suggerito nel post #39 e successivo #44 solo che si cambia posizione in modo che agisca solo nella zona del Select Case.
Vedi che hai ancora molte celle nei vari fogli molto "sporche" e questo continuerà a crearti crticità; te l'avevo già segnalato nel post #54. 
Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    Dim R As Long
    
    If ActiveSheet.Name <> "RIEP" And ActiveSheet.Name <> "codici servizi" Then     'escluso questi fogli
        R = Target.Row
        ' questo codice ti segnala con un messaggio se per sbaglio scrivi riposo nella colonna "I" con il codice 2-3-4
        If Not Intersect(Target, [I14:I57]) Is Nothing Then
            If Range("I" & R) = 2 Or Range("I" & R) = 3 Or Range("I" & R) = 4 Then
                MsgBox "Qui va messo solo codice presenza"
                Application.EnableEvents = False
                Target.ClearContents
                Application.EnableEvents = True
            End If
        End If
        ' questo codice ti da un messaggio di errore se per sbaglio metti riposo lo stesso giorno che hai lavorato
        If Target.Count > 1 Then Exit Sub   'riga nuova, se sono selezionate più celle ... abbandona
        If Intersect(Target, Uni0n(Range("C14:C57"), Range("J14:J57"))) Is Nothing Then Exit Sub
        Select Case Target.Column
            Case 2, 3
                If Range("J" & R) <> "" Then
                    MsgBox "Non puoi scrivere in questa cella se colonna J non è vuota"
                    Application.EnableEvents = False
                    Target.ClearContents
                    Application.EnableEvents = True
                    Exit Sub
                End If
            Case 10
                If Range("C" & R) <> "" Then
                    MsgBox "Non puoi scrivere in questa cella se colonna C non è vuota"
                    Application.EnableEvents = False
                    Target.ClearContents
                    Application.EnableEvents = True
                    Exit Sub
                ' se colonna A è colorata in questa cella puoi scrivere solo 3
                ElseIf Target <> "" Then    'modificato il confronto, aggiunta condizione cella vuota
                    If Range("A" & R).DisplayFormat.Interior.ColorIndex <> xlColorIndexNone And Target <> 3 Then
                        MsgBox "Puoi scrivere solo 3 se colonna A è colorata"
                        Application.EnableEvents = False
                        Target.ClearContents
                        Application.EnableEvents = True
                        Exit Sub
                    End If
                End If
        End Select
    End If
    
End Sub
[Modificato da rollis13 27/01/2018 20:09]

______________________________________________________________
C'è chi fa le COSE a CASO e chi fa CASO alle COSE (Ignoto)
trittico69
Post: 198
Registrato il: 02/04/2010
Città: MILANO
Età: 54
Utente Junior
2002
OFFLINE
29/01/2018 09:37
00#70
ok rollis il codice sembra andare bene...fammi capire il significato di celle sporche con un esempio...
poi ho visto che nell'ultimo codice non mi hai messo piu Call minuti...
l'hai omessa per qualche motivo o una dimenticanza?
mentre per quanto riguarda
Application.EnableEvents = True
mentre per disattivare il controllo degli eventi dovrebbe essere:
Application.EnableEvents = False
devo cambiare solo il primo del codice o tutti, dello stesso codice?
grazie
[Modificato da trittico69 29/01/2018 15:03]
excel 2003
rollis13
Post: 640
Registrato il: 16/08/2015
Città: CORDENONS
Età: 67
Utente Senior
Excel 2016-32bit Win11
OFFLINE
29/01/2018 22:03
00#71
La riga "Call minuti" manca nell'ultima mia versione della macro perché sono partito da quanto trovato nell'ultimo file che hai allegato al post #68 dove non c'è più traccia della riga che ti avevo indicato nel mio post #67 e così pure tutte le altre modifiche suggerite.
Se non fai i compiti per casa come può fare chi cerca di aiutarti; personalmente prendo sempre per buono l'ultimo file allegato e se mancano le modifiche suggerite prendo atto, l'utente avrà le sue buone ragioni per non averle prese in considerazione, e tant'è ... si aggiusta quello che c'è ...

______________________________________________________________
C'è chi fa le COSE a CASO e chi fa CASO alle COSE (Ignoto)
trittico69
Post: 199
Registrato il: 02/04/2010
Città: MILANO
Età: 54
Utente Junior
2002
OFFLINE
30/01/2018 08:44
00#72
Hai ragione.... ho fatto un po' di confusione perché ho fatto una copia per fare le prove di modifica poi, quando vedo che va bene, lo metto su file originale.... e ti ho mandato un file vecchio... mia culpa... Comunquei call minuti che manca glieli posso mettere io.. mi potresti fare un esempio di Celle sporche in modo che posso pulirle perché non so cosa siano..mentre per quanto riguarda
Application.EnableEvents = True
mentre per disattivare il controllo degli eventi dovrebbe essere:
Application.EnableEvents = False
devo cambiare solo il primo del codice o tutti, dello stesso codice?
grazie
[Modificato da trittico69 30/01/2018 13:55]
excel 2003
rollis13
Post: 641
Registrato il: 16/08/2015
Città: CORDENONS
Età: 67
Utente Senior
Excel 2016-32bit Win11
OFFLINE
30/01/2018 23:17
00#73
Prima di tutto hai centinaia di celle inutilmente occupate. Te ne accorgi semplicemente facendo un Ctrl+Fine in tutti i fogli e noterai che il cursore ti si ferma verso la riga 300 (c'è chi va anche oltre). Se selezioni tutte le righe dopo l'ultima utilizzata fino alla fine del foglio e le Elimini e fai la stessa cosa per le colonne per poi salvare il file noterai che la sua dimensione si riduce di parecchio.

Poi ci sono alcune celle che sembrano vuote ma in realtà non lo sono. Molti post fa ne avevo riscontrate diverse ma ora non ho nessuna intensione di cercarle nuovamente; te ne accorgi quando in alcune righe fai un'operazione e la stessa non va a buon fine mentre in altre righe funziona benissimo.

"Application.EnableEvents = False" e "Application.EnableEvents = True" vanno sempre in coppia, prima il "False" per disattivare la gestione degli eventi e quando servono nuovamente si mette il "True".

______________________________________________________________
C'è chi fa le COSE a CASO e chi fa CASO alle COSE (Ignoto)
trittico69
Post: 200
Registrato il: 02/04/2010
Città: MILANO
Età: 54
Utente Junior
2002
OFFLINE
31/01/2018 07:30
00#74
rollis per favore vedi se ho modificato bene il codice "minuti"...ne ho fatto solo un pezzo se mi confermi che ho capito bene lo faccio tutto.
Per quanto riguarda le celle occupate ho fatto il lavoro che mi hai suggerito ed effettivamente il file è diventato molto piu piccolo.
Pero adesso rileggendo le tue indicazioni vedo che hai scritto di selezionare le colonne e celle ed “elimina” mentre il ho fatto con il tasto “canc” credo sia lo stesso visto che il file si è ridotto..se puoi darmi una conferma altrimenti rifaccio il lavoro con “elimina”

Mentre non ho capito bene questo
“Poi ci sono alcune celle che sembrano vuote ma in realtà non lo sono. Molti post fa ne avevo riscontrate diverse ma ora non ho nessuna intensione di cercarle nuovamente; te ne accorgi quando in alcune righe fai un'operazione e la stessa non va a buon fine mentre in altre righe funziona benissimo.”
Se mi fai fare un esempio.
grazie


Sub minuti() ' questo codice si avvia con il rigo fine call minuti che si trova nel this workbook
Dim AG As Range
Dim AH As Range
Dim AI As Range
Dim F As Range
Dim G As Range
Dim H As Range
Dim vero As Boolean

Set AG = ThisWorkbook.ActiveSheet.Range("AG31")
Set AH = ThisWorkbook.ActiveSheet.Range("AH31")
Set AI = ThisWorkbook.ActiveSheet.Range("AI31")
Set F = ThisWorkbook.ActiveSheet.Range("F10")
Set G = ThisWorkbook.ActiveSheet.Range("G10")
Set H = ThisWorkbook.ActiveSheet.Range("H10")

vero = False
If ActiveSheet.Name = "RIEP" Then vero = True
If Not vero Then

Select Case True

'SE LA SOMMA DEI MINUTI DELLE 3 CELLE SONO MINORI O UGUALI A 30 NON FARE NULLA

Case VBA.Minute(AG) + VBA.Minute(AH) + VBA.Minute(AI) <= 30
Application.EnableEvents = False
If Round(AG, 14) >= 1 Then F = Round(AG, 14) * 24 Else F = VBA.Hour(AG)
If Round(AH, 14) >= 1 Then G = Round(AH, 14) * 24 Else G = VBA.Hour(AH)
If Round(AI, 14) >= 1 Then H = Round(AI, 14) * 24 Else H = VBA.Hour(AI)


Case VBA.Minute(AG) = 0 _
And VBA.Minute(AH) > 30 _
And VBA.Minute(AI) > 30 _
And VBA.Minute(AH) + VBA.Minute(AI) < 90
Application.EnableEvents = true
If Round(AG, 14) >= 1 Then F = Round(AG, 14) * 24 Else F = VBA.Hour(AG)
If Round(AH, 14) >= 1 Then G = Round(AH, 14) * 24 Else G = VBA.Hour(AH)
If Round(AI, 14) >= 1 Then H = Round(AI, 14) * 24 + 1 Else H = VBA.Hour(AI) + 1

Case VBA.Minute(AG) = 0 _
And VBA.Minute(AH) > 30 _
And VBA.Minute(AI) > 30 _
And VBA.Minute(AH) + VBA.Minute(AI) > 90
Application.EnableEvents = False
If Round(AG, 14) >= 1 Then F = Round(AG, 14) * 24 Else F = VBA.Hour(AG)
If Round(AH, 14) >= 1 Then G = Round(AH, 14) * 24 + 1 Else G = VBA.Hour(AH) + 1
If Round(AI, 14) >= 1 Then H = Round(AI, 14) * 24 + 1 Else H = VBA.Hour(AI) + 1

'SE LA SOMMA DEI MINUTI DELLA 1ª E 2ª CELLA SONO MAGGIORI DI 30,
'MA MINORE O UGUALE A 90 E I MINUTI DELLA 1ª CELLA SONO
'MAGGIORI O UGUALI ALLA 2ª CELLA INCREMENTA LA 1ª CELLA DI 1 ORA

Case VBA.Minute(AG) > 0 _
And VBA.Minute(AH) > 0 _
And VBA.Minute(AI) = 0 _
And VBA.Minute(AG) >= VBA.Minute(AH) _
And VBA.Minute(AG) + VBA.Minute(AH) > 30 _
And VBA.Minute(AG) + VBA.Minute(AH) <= 90
Application.EnableEvents = true
If Round(AG, 14) >= 1 Then F = Round(AG, 14) * 24 + 1 Else F = VBA.Hour(AG) + 1
If Round(AH, 14) >= 1 Then G = Round(AH, 14) * 24 Else G = VBA.Hour(AH)
If Round(AI, 14) >= 1 Then H = Round(AI, 14) * 24 Else H = VBA.Hour(AI)


'SE LA SOMMA DEI MINUTI DELLA 1ª E 2ª CELLA SONO MAGGIORI DI 30,
'MA MINORE O UGUALE A 90 E I MINUTI DELLA 1ª CELLA SONO
'MINORI ALLA 2ª CELLA INCREMENTA LA 2ª CELLA DI 1 ORA

Case VBA.Minute(AG) > 0 _
And VBA.Minute(AH) > 0 _
And VBA.Minute(AI) = 0 _
And VBA.Minute(AG) < VBA.Minute(AH) _
And VBA.Minute(AG) + VBA.Minute(AH) > 30 _
And VBA.Minute(AG) + VBA.Minute(AH) <= 90
Application.EnableEvents = False
If Round(AG, 14) >= 1 Then F = Round(AG, 14) * 24 Else F = VBA.Hour(AG)
If Round(AH, 14) >= 1 Then G = Round(AH, 14) * 24 + 1 Else G = VBA.Hour(AH) + 1
If Round(AI, 14) >= 1 Then H = Round(AI, 14) * 24 Else H = VBA.Hour(AI)


'SE LA SOMMA DEI MINUTI DELLA 1ª E 2ª CELLA SONO MAGGIORI DI 90,
'MA MINORE O UGUALE A 120 E I MINUTI DELLA 1ª CELLA SONO
'MINORI ALLA 2ª CELLA INCREMENTA LA 1ª E LA 2ª CELLA DI 1 ORA

Case VBA.Minute(AG) > 0 _
And VBA.Minute(AH) > 0 _
And VBA.Minute(AI) = 0 _
And VBA.Minute(AG) < VBA.Minute(AH) _
And VBA.Minute(AG) + VBA.Minute(AH) > 90 _
And VBA.Minute(AG) + VBA.Minute(AH) <= 120
Application.EnableEvents = true
If Round(AG, 14) >= 1 Then F = Round(AG, 14) * 24 + 1 Else F = VBA.Hour(AG) + 1
If Round(AH, 14) >= 1 Then G = Round(AH, 14) * 24 + 1 Else G = VBA.Hour(AH) + 1
If Round(AI, 14) >= 1 Then H = Round(AI, 14) * 24 Else H = VBA.Hour(AI)


'SE LA SOMMA DEI MINUTI DELLA 1ª E 3ª CELLA SONO MAGGIORI DI 30,
'MA MINORE O UGUALE A 90 E I MINUTI DELLA 1ª CELLA SONO
'MAGGIORI O UGUALI ALLA 3ª CELLA INCREMENTA LA 2ª CELLA DI 1 ORA

Case VBA.Minute(AG) > 0 _
And VBA.Minute(AH) = 0 _
And VBA.Minute(AI) > 0 _
And VBA.Minute(AG) >= VBA.Minute(AI) _
And VBA.Minute(AG) + VBA.Minute(AI) > 30 _
And VBA.Minute(AG) + VBA.Minute(AI) <= 90
Application.EnableEvents = False
If Round(AG, 14) >= 1 Then F = Round(AG, 14) * 24 Else F = VBA.Hour(AG)
If Round(AH, 14) >= 1 Then G = Round(AH, 14) * 24 + 1 Else G = VBA.Hour(AH) + 1
If Round(AI, 14) >= 1 Then H = Round(AI, 14) * 24 Else H = VBA.Hour(AI)


'SE LA SOMMA DEI MINUTI DELLA 1ª E 3ª CELLA SONO MAGGIORI DI 30,
'MA MINORE O UGUALE A 90 E I MINUTI DELLA 1ª CELLA SONO
'MINORI ALLA 3ª CELLA INCREMENTA LA 3ª CELLA DI 1 ORA

Case VBA.Minute(AG) > 0 _
And VBA.Minute(AH) = 0 _
And VBA.Minute(AI) > 0 _
And VBA.Minute(AG) < VBA.Minute(AI) _
And VBA.Minute(AG) + VBA.Minute(AI) > 30 _
And VBA.Minute(AG) + VBA.Minute(AI) <= 90
Application.EnableEvents = true
If Round(AG, 14) >= 1 Then F = Round(AG, 14) * 24 Else F = VBA.Hour(AG)
If Round(AH, 14) >= 1 Then G = Round(AH, 14) * 24 Else G = VBA.Hour(AH)
If Round(AI, 14) >= 1 Then H = Round(AI, 14) * 24 + 1 Else H = VBA.Hour(AI) + 1


'SE LA SOMMA DEI MINUTI DELLA 1ª E 3ª CELLA SONO MAGGIORI DI 90,
'MA MINORE O UGUALE A 120 E I MINUTI DELLA 1ª CELLA SONO
'MINORI O UGUALI ALLA 3ª CELLA INCREMENTA LA 2ª E LA 3ª CELLA DI 1 ORA

Case VBA.Minute(AG) > 0 _
And VBA.Minute(AH) = 0 _
And VBA.Minute(AI) > 0 _
And VBA.Minute(AG) <= VBA.Minute(AI) _
And VBA.Minute(AG) + VBA.Minute(AI) > 90 _
And VBA.Minute(AG) + VBA.Minute(AI) <= 120
Application.EnableEvents = False
If Round(AG, 14) >= 1 Then F = Round(AG, 14) * 24 Else F = VBA.Hour(AG)
If Round(AH, 14) >= 1 Then G = Round(AH, 14) * 24 + 1 Else G = VBA.Hour(AH) + 1
If Round(AI, 14) >= 1 Then H = Round(AI, 14) * 24 + 1 Else H = VBA.Hour(AI) + 1
[Modificato da trittico69 31/01/2018 08:26]
excel 2003
trittico69
Post: 201
Registrato il: 02/04/2010
Città: MILANO
Età: 54
Utente Junior
2002
OFFLINE
02/02/2018 11:43
00#75
rollis mi fai sapere se non mi rispondi perchè ho chiesto troppo o semplicemente perchè non hai avuto tempo?
grazie
excel 2003
rollis13
Post: 644
Registrato il: 16/08/2015
Città: CORDENONS
Età: 67
Utente Senior
Excel 2016-32bit Win11
OFFLINE
04/02/2018 23:47
00#76
Quella che hai indicato come macro "minuti" a naso mi sembra un vecchia versione. Dopo le varie modifiche introdotte nei vari thread a me risulta che questa sotto riportata sia l'ultima versione.

Inoltre, per quanto riguarda le celle che sembrano vuote ma in realtà non lo sono, fai questa prova in diversi fogli e in diverse righe perché alcune sono a posto: in una riga vuota prova a scrivere un numero diverso da 3 in colonna J e ti viene segnalato che la cella in colonna A è colorata anche se non lo è. Non è un abbaglio della macro, la cella in A è "sporca".
Per sistemare basta applicare a tutte le celle della colonna A la formattazione con un riempimento nullo. 

Option Explicit

Sub minuti()

    Dim AG As Range
    Dim AH As Range
    Dim AI As Range
    Dim F As Range
    Dim G As Range
    Dim H As Range
    
    Set AG = ThisWorkbook.ActiveSheet.Range("AG31")
    Set AH = ThisWorkbook.ActiveSheet.Range("AH31")
    Set AI = ThisWorkbook.ActiveSheet.Range("AI31")
    Set F = ThisWorkbook.ActiveSheet.Range("F10")
    Set G = ThisWorkbook.ActiveSheet.Range("G10")
    Set H = ThisWorkbook.ActiveSheet.Range("H10")
    If ActiveSheet.Name <> "RIEP" And ActiveSheet.Name <> "codici servizi" Then
        ActiveSheet.Unprotect
        Application.EnableEvents = False
        Select Case True
             'SE LA SOMMA DEI MINUTI DELLE 3 CELLE SONO MINORI O UGUALI A 30 NON FARE NULLA
            Case VBA.Minute(AG) + VBA.Minute(AH) + VBA.Minute(AI) <= 30
               If Round(AG, 14) >= 1 Then F = Round(AG, 14) * 24 Else F = VBA.Hour(AG)
               If Round(AH, 14) >= 1 Then G = Round(AH, 14) * 24 Else G = VBA.Hour(AH)
               If Round(AI, 14) >= 1 Then H = Round(AI, 14) * 24 Else H = VBA.Hour(AI)
            Case VBA.Minute(AG) = 0 _
                    And VBA.Minute(AH) > 30 _
                    And VBA.Minute(AI) > 30 _
                    And VBA.Minute(AH) + VBA.Minute(AI) < 90
               If Round(AG, 14) >= 1 Then F = Round(AG, 14) * 24 Else F = VBA.Hour(AG)
               If Round(AH, 14) >= 1 Then G = Round(AH, 14) * 24 Else G = VBA.Hour(AH)
               If Round(AI, 14) >= 1 Then H = Round(AI, 14) * 24 + 1 Else H = VBA.Hour(AI) + 1
            Case VBA.Minute(AG) = 0 _
                    And VBA.Minute(AH) > 30 _
                    And VBA.Minute(AI) > 30 _
                    And VBA.Minute(AH) + VBA.Minute(AI) > 90
               If Round(AG, 14) >= 1 Then F = Round(AG, 14) * 24 Else F = VBA.Hour(AG)
               If Round(AH, 14) >= 1 Then G = Round(AH, 14) * 24 + 1 Else G = VBA.Hour(AH) + 1
               If Round(AI, 14) >= 1 Then H = Round(AI, 14) * 24 + 1 Else H = VBA.Hour(AI) + 1
             'SE LA SOMMA DEI MINUTI DELLA 1ª E 2ª CELLA SONO MAGGIORI DI 30,
             'MA MINORE O UGUALE A 90 E I MINUTI DELLA 1ª CELLA SONO
             'MAGGIORI O UGUALI ALLA 2ª CELLA INCREMENTA LA 1ª CELLA DI 1 ORA
            Case VBA.Minute(AG) > 0 _
                    And VBA.Minute(AH) > 0 _
                    And VBA.Minute(AI) = 0 _
                    And VBA.Minute(AG) >= VBA.Minute(AH) _
                    And VBA.Minute(AG) + VBA.Minute(AH) > 30 _
                    And VBA.Minute(AG) + VBA.Minute(AH) <= 90
               If Round(AG, 14) >= 1 Then F = Round(AG, 14) * 24 + 1 Else F = VBA.Hour(AG) + 1
               If Round(AH, 14) >= 1 Then G = Round(AH, 14) * 24 Else G = VBA.Hour(AH)
               If Round(AI, 14) >= 1 Then H = Round(AI, 14) * 24 Else H = VBA.Hour(AI)
             'SE LA SOMMA DEI MINUTI DELLA 1ª E 2ª CELLA SONO MAGGIORI DI 30,
             'MA MINORE O UGUALE A 90 E I MINUTI DELLA 1ª CELLA SONO
             'MINORI ALLA 2ª CELLA INCREMENTA LA 2ª CELLA DI 1 ORA
            Case VBA.Minute(AG) > 0 _
                    And VBA.Minute(AH) > 0 _
                    And VBA.Minute(AI) = 0 _
                    And VBA.Minute(AG) < VBA.Minute(AH) _
                    And VBA.Minute(AG) + VBA.Minute(AH) > 30 _
                    And VBA.Minute(AG) + VBA.Minute(AH) <= 90
               If Round(AG, 14) >= 1 Then F = Round(AG, 14) * 24 Else F = VBA.Hour(AG)
               If Round(AH, 14) >= 1 Then G = Round(AH, 14) * 24 + 1 Else G = VBA.Hour(AH) + 1
               If Round(AI, 14) >= 1 Then H = Round(AI, 14) * 24 Else H = VBA.Hour(AI)
             'SE LA SOMMA DEI MINUTI DELLA 1ª E 2ª CELLA SONO MAGGIORI DI 90,
             'MA MINORE O UGUALE A 120 E I MINUTI DELLA 1ª CELLA SONO
             'MINORI ALLA 2ª CELLA INCREMENTA LA 1ª E LA 2ª CELLA DI 1 ORA
            Case VBA.Minute(AG) > 0 _
                    And VBA.Minute(AH) > 0 _
                    And VBA.Minute(AI) = 0 _
                    And VBA.Minute(AG) < VBA.Minute(AH) _
                    And VBA.Minute(AG) + VBA.Minute(AH) > 90 _
                    And VBA.Minute(AG) + VBA.Minute(AH) <= 120
               If Round(AG, 14) >= 1 Then F = Round(AG, 14) * 24 + 1 Else F = VBA.Hour(AG) + 1
               If Round(AH, 14) >= 1 Then G = Round(AH, 14) * 24 + 1 Else G = VBA.Hour(AH) + 1
               If Round(AI, 14) >= 1 Then H = Round(AI, 14) * 24 Else H = VBA.Hour(AI)
             'SE LA SOMMA DEI MINUTI DELLA 1ª E 3ª CELLA SONO MAGGIORI DI 30,
             'MA MINORE O UGUALE A 90 E I MINUTI DELLA 1ª CELLA SONO
             'MAGGIORI O UGUALI ALLA 3ª CELLA INCREMENTA LA 2ª CELLA DI 1 ORA
            Case VBA.Minute(AG) > 0 _
                    And VBA.Minute(AH) = 0 _
                    And VBA.Minute(AI) > 0 _
                    And VBA.Minute(AG) >= VBA.Minute(AI) _
                    And VBA.Minute(AG) + VBA.Minute(AI) > 30 _
                    And VBA.Minute(AG) + VBA.Minute(AI) <= 90
               If Round(AG, 14) >= 1 Then F = Round(AG, 14) * 24 Else F = VBA.Hour(AG)
               If Round(AH, 14) >= 1 Then G = Round(AH, 14) * 24 + 1 Else G = VBA.Hour(AH) + 1
               If Round(AI, 14) >= 1 Then H = Round(AI, 14) * 24 Else H = VBA.Hour(AI)
             'SE LA SOMMA DEI MINUTI DELLA 1ª E 3ª CELLA SONO MAGGIORI DI 30,
             'MA MINORE O UGUALE A 90 E I MINUTI DELLA 1ª CELLA SONO
             'MINORI  ALLA 3ª CELLA INCREMENTA LA 3ª CELLA DI 1 ORA
            Case VBA.Minute(AG) > 0 _
                    And VBA.Minute(AH) = 0 _
                    And VBA.Minute(AI) > 0 _
                    And VBA.Minute(AG) < VBA.Minute(AI) _
                    And VBA.Minute(AG) + VBA.Minute(AI) > 30 _
                    And VBA.Minute(AG) + VBA.Minute(AI) <= 90
               If Round(AG, 14) >= 1 Then F = Round(AG, 14) * 24 Else F = VBA.Hour(AG)
               If Round(AH, 14) >= 1 Then G = Round(AH, 14) * 24 Else G = VBA.Hour(AH)
               If Round(AI, 14) >= 1 Then H = Round(AI, 14) * 24 + 1 Else H = VBA.Hour(AI) + 1
             'SE LA SOMMA DEI MINUTI DELLA 1ª E 3ª CELLA SONO MAGGIORI DI 90,
             'MA MINORE O UGUALE A 120 E I MINUTI DELLA 1ª CELLA SONO
             'MINORI O UGUALI ALLA 3ª CELLA INCREMENTA LA 2ª E LA 3ª CELLA DI 1 ORA
            Case VBA.Minute(AG) > 0 _
                    And VBA.Minute(AH) = 0 _
                    And VBA.Minute(AI) > 0 _
                    And VBA.Minute(AG) <= VBA.Minute(AI) _
                    And VBA.Minute(AG) + VBA.Minute(AI) > 90 _
                    And VBA.Minute(AG) + VBA.Minute(AI) <= 120
               If Round(AG, 14) >= 1 Then F = Round(AG, 14) * 24 Else F = VBA.Hour(AG)
               If Round(AH, 14) >= 1 Then G = Round(AH, 14) * 24 + 1 Else G = VBA.Hour(AH) + 1
               If Round(AI, 14) >= 1 Then H = Round(AI, 14) * 24 + 1 Else H = VBA.Hour(AI) + 1
             'SE LA SOMMA DEI MINUTI DELLA 2ª E 3ª CELLA SONO MAGGIORI DI 30,
             'MA MINORE O UGUALE A 90 E I MINUTI DELLA 2ª CELLA SONO
             'MAGGIORI O UGUALI ALLA 3ª CELLA INCREMENTA LA 2ª CELLA DI 1 ORA
            Case VBA.Minute(AG) = 0 _
                    And VBA.Minute(AH) > 0 _
                    And VBA.Minute(AI) > 0 _
                    And VBA.Minute(AH) >= VBA.Minute(AI) _
                    And VBA.Minute(AH) + VBA.Minute(AI) > 30 _
                    And VBA.Minute(AH) + VBA.Minute(AI) <= 90
               If Round(AG, 14) >= 1 Then F = Round(AG, 14) * 24 Else F = VBA.Hour(AG)
               If Round(AH, 14) >= 1 Then G = Round(AH, 14) * 24 + 1 Else G = VBA.Hour(AH) + 1
               If Round(AI, 14) >= 1 Then H = Round(AI, 14) * 24 Else H = VBA.Hour(AI)
             'SE LA SOMMA DEI MINUTI DELLA 2ª E 3ª CELLA SONO MAGGIORI DI 30,
             'MA MINORE O UGUALE A 90 E I MINUTI DELLA 2ª CELLA SONO
             'MINORI ALLA 3ª CELLA INCREMENTA LA 3ª CELLA DI 1 ORA
            Case VBA.Minute(AG) = 0 _
                    And VBA.Minute(AH) > 0 _
                    And VBA.Minute(AI) > 0 _
                    And VBA.Minute(AH) < VBA.Minute(AI) _
                    And VBA.Minute(AH) + VBA.Minute(AI) > 30 _
                    And VBA.Minute(AH) + VBA.Minute(AI) <= 90
               If Round(AG, 14) >= 1 Then F = Round(AG, 14) * 24 Else F = VBA.Hour(AG)
               If Round(AH, 14) >= 1 Then G = Round(AH, 14) * 24 Else G = VBA.Hour(AH)
               If Round(AI, 14) >= 1 Then H = Round(AI, 14) * 24 + 1 Else H = VBA.Hour(AI) + 1
             'SE LA SOMMA DEI MINUTI DELLA 2ª E 3ª CELLA SONO MAGGIORI DI 90,
             'MA MINORE O UGUALE A 120 E I MINUTI DELLA 2ª CELLA SONO
             'MINORI O UGUALI ALLA 3ª CELLA INCREMENTA LA 2ª E LA 3ª CELLA DI 1 ORA
            Case VBA.Minute(AG) = 0 _
                    And VBA.Minute(AH) > 0 _
                    And VBA.Minute(AI) > 0 _
                    And VBA.Minute(AH) <= VBA.Minute(AI) _
                    And VBA.Minute(AH) + VBA.Minute(AI) > 90 _
                    And VBA.Minute(AH) + VBA.Minute(AI) <= 120
               If Round(AG, 14) >= 1 Then F = Round(AG, 14) * 24 Else F = VBA.Hour(AG)
               If Round(AH, 14) >= 1 Then G = Round(AH, 14) * 24 + 1 Else G = VBA.Hour(AH) + 1
               If Round(AI, 14) >= 1 Then H = Round(AI, 14) * 24 + 1 Else H = VBA.Hour(AI) + 1
            Case VBA.Minute(AG) > 0 _
                    And VBA.Minute(AH) > 0 _
                    And VBA.Minute(AI) > 0 _
                    And VBA.Minute(AG) < 30 _
                    And VBA.Minute(AH) < 30 _
                    And VBA.Minute(AI) < 30 _
                    And VBA.Minute(AG) + VBA.Minute(AH) + VBA.Minute(AI) > 30 _
                    And VBA.Minute(AG) + VBA.Minute(AH) + VBA.Minute(AI) < 90
               If Round(AG, 14) >= 1 Then F = Round(AG, 14) * 24 Else F = VBA.Hour(AG)
               If Round(AH, 14) >= 1 Then G = Round(AH, 14) * 24 + 1 Else G = VBA.Hour(AH) + 1
               If Round(AI, 14) >= 1 Then H = Round(AI, 14) * 24 Else H = VBA.Hour(AI)
             'ARROTONDA IN ECCESSO LA CELLA CON PIU' DI 30 MINUTI SE I MINUTI
             'DELLE ALTRE DUE CELLE SONO UGUALI A ZERO
            Case VBA.Minute(AG) > 30 _
                    And VBA.Minute(AH) = 0 _
                    And VBA.Minute(AI) = 0
               If Round(AG, 14) >= 1 Then F = Round(AG, 14) * 24 + 1 Else F = VBA.Hour(AG) + 1
               If Round(AH, 14) >= 1 Then G = Round(AH, 14) * 24 Else G = VBA.Hour(AH)
               If Round(AI, 14) >= 1 Then H = Round(AI, 14) * 24 Else H = VBA.Hour(AI)
            Case VBA.Minute(AG) = 0 _
                    And VBA.Minute(AH) > 30 _
                    And VBA.Minute(AI) = 0
               If Round(AG, 14) >= 1 Then F = Round(AG, 14) * 24 Else F = VBA.Hour(AG)
               If Round(AH, 14) >= 1 Then G = Round(AH, 14) * 24 + 1 Else G = VBA.Hour(AH) + 1
               If Round(AI, 14) >= 1 Then H = Round(AI, 14) * 24 Else H = VBA.Hour(AI)
            Case VBA.Minute(AG) = 0 _
                    And VBA.Minute(AH) = 0 _
                    And VBA.Minute(AI) > 30
               If Round(AG, 14) >= 1 Then F = Round(AG, 14) * 24 Else F = VBA.Hour(AG)
               If Round(AH, 14) >= 1 Then G = Round(AH, 14) * 24 Else G = VBA.Hour(AH)
               If Round(AI, 14) >= 1 Then H = Round(AI, 14) * 24 + 1 Else H = VBA.Hour(AI) + 1
            Case VBA.Minute(AG) > 30 _
                    And VBA.Minute(AH) < 30 _
                    And VBA.Minute(AI) < 30 _
                    And VBA.Minute(AH) + VBA.Minute(AI) > 30 _
                    And VBA.Minute(AG) + VBA.Minute(AH) + VBA.Minute(AI) < 120
               If Round(AG, 14) >= 1 Then F = Round(AG, 14) * 24 Else F = VBA.Hour(AG)
               If Round(AH, 14) >= 1 Then G = Round(AH, 14) * 24 + 1 Else G = VBA.Hour(AH) + 1
               If Round(AI, 14) >= 1 Then H = Round(AI, 14) * 24 Else H = VBA.Hour(AI)
            Case VBA.Minute(AG) < 30 _
                    And VBA.Minute(AH) > 30 _
                    And VBA.Minute(AI) < 30 _
                    And VBA.Minute(AG) + VBA.Minute(AI) > 30 _
                    And VBA.Minute(AG) + VBA.Minute(AH) + VBA.Minute(AI) < 120
               If Round(AG, 14) >= 1 Then F = Round(AG, 14) * 24 Else F = VBA.Hour(AG)
               If Round(AH, 14) >= 1 Then G = Round(AH, 14) * 24 + 1 Else G = VBA.Hour(AH) + 1
               If Round(AI, 14) >= 1 Then H = Round(AI, 14) * 24 Else H = VBA.Hour(AI)
            Case VBA.Minute(AG) < 30 _
                    And VBA.Minute(AH) < 30 _
                    And VBA.Minute(AI) > 30 _
                    And VBA.Minute(AG) + VBA.Minute(AH) > 30 _
                    And VBA.Minute(AG) + VBA.Minute(AH) + VBA.Minute(AI) < 120
               If Round(AG, 14) >= 1 Then F = Round(AG, 14) * 24 Else F = VBA.Hour(AG)
               If Round(AH, 14) >= 1 Then G = Round(AH, 14) * 24 Else G = VBA.Hour(AH)
               If Round(AI, 14) >= 1 Then H = Round(AI, 14) * 24 + 1 Else H = VBA.Hour(AI) + 1
            Case VBA.Minute(AG) > 30 _
                    And VBA.Minute(AH) < 30 _
                    And VBA.Minute(AI) < 30 _
                    And VBA.Minute(AH) + VBA.Minute(AI) < 30
               If Round(AG, 14) >= 1 Then F = Round(AG, 14) * 24 + 1 Else F = VBA.Hour(AG) + 1
               If Round(AH, 14) >= 1 Then G = Round(AH, 14) * 24 Else G = VBA.Hour(AH)
               If Round(AI, 14) >= 1 Then H = Round(AI, 14) * 24 Else H = VBA.Hour(AI)
            Case VBA.Minute(AG) < 30 _
                    And VBA.Minute(AH) > 30 _
                    And VBA.Minute(AI) < 30 _
                    And VBA.Minute(AG) + VBA.Minute(AI) < 30
               If Round(AG, 14) >= 1 Then F = Round(AG, 14) * 24 Else F = VBA.Hour(AG)
               If Round(AH, 14) >= 1 Then G = Round(AH, 14) * 24 + 1 Else G = VBA.Hour(AH) + 1
               If Round(AI, 14) >= 1 Then H = Round(AI, 14) * 24 Else H = VBA.Hour(AI)
            Case VBA.Minute(AG) < 30 _
                    And VBA.Minute(AH) < 30 _
                    And VBA.Minute(AI) > 30 _
                    And VBA.Minute(AG) + VBA.Minute(AH) < 30
               If Round(AG, 14) >= 1 Then F = Round(AG, 14) * 24 Else F = VBA.Hour(AG)
               If Round(AH, 14) >= 1 Then G = Round(AH, 14) * 24 Else G = VBA.Hour(AH)
               If Round(AI, 14) >= 1 Then H = Round(AI, 14) * 24 + 1 Else H = VBA.Hour(AI) + 1
             'SE I MINUTI DELLE TRE CELLE SONO UGUALI A 30 ARROTONDA IN ECCESSO LA TERZA CELLA
            Case VBA.Minute(AG) = 30 _
                    And VBA.Minute(AH) = 30 _
                    And VBA.Minute(AI) = 30
               If Round(AG, 14) >= 1 Then F = Round(AG, 14) * 24 Else F = VBA.Hour(AG)
               If Round(AH, 14) >= 1 Then G = Round(AH, 14) * 24 Else G = VBA.Hour(AH)
               If Round(AI, 14) >= 1 Then H = Round(AI, 14) * 24 + 1 Else H = VBA.Hour(AI) + 1
            Case VBA.Minute(AG) > 30 _
                    And VBA.Minute(AH) = 30 _
                    And VBA.Minute(AI) = 30 _
                    And VBA.Minute(AG) + VBA.Minute(AH) + VBA.Minute(AI) > 90 _
                    And VBA.Minute(AG) + VBA.Minute(AH) + VBA.Minute(AI) < 120
               If Round(AG, 14) >= 1 Then F = Round(AG, 14) * 24 + 1 Else F = VBA.Hour(AG) + 1
               If Round(AH, 14) >= 1 Then G = Round(AH, 14) * 24 Else G = VBA.Hour(AH)
               If Round(AI, 14) >= 1 Then H = Round(AI, 14) * 24 + 1 Else H = VBA.Hour(AI) + 1
            Case VBA.Minute(AG) > 30 _
                    And VBA.Minute(AH) > 30 _
                    And VBA.Minute(AI) > 30 _
                    And VBA.Minute(AG) + VBA.Minute(AH) + VBA.Minute(AI) > 120 _
                    And VBA.Minute(AG) + VBA.Minute(AH) + VBA.Minute(AI) < 150
               If Round(AG, 14) >= 1 Then F = Round(AG, 14) * 24 + 1 Else F = VBA.Hour(AG) + 1
               If Round(AH, 14) >= 1 Then G = Round(AH, 14) * 24 Else G = VBA.Hour(AH)
               If Round(AI, 14) >= 1 Then H = Round(AI, 14) * 24 + 1 Else H = VBA.Hour(AI) + 1
            Case VBA.Minute(AG) > 30 _
                    And VBA.Minute(AH) > 30 _
                    And VBA.Minute(AI) > 30 _
                    And VBA.Minute(AG) + VBA.Minute(AH) + VBA.Minute(AI) = 150
               If Round(AG, 14) >= 1 Then F = Round(AG, 14) * 24 Else F = VBA.Hour(AG)
               If Round(AH, 14) >= 1 Then G = Round(AH, 14) * 24 + 1 Else G = VBA.Hour(AH) + 1
               If Round(AI, 14) >= 1 Then H = Round(AI, 14) * 24 + 1 Else H = VBA.Hour(AI) + 1
            Case VBA.Minute(AG) > 30 _
                    And VBA.Minute(AH) > 30 _
                    And VBA.Minute(AI) > 30 _
                    And VBA.Minute(AG) + VBA.Minute(AH) + VBA.Minute(AI) > 150
               If Round(AG, 14) >= 1 Then F = Round(AG, 14) * 24 + 1 Else F = VBA.Hour(AG) + 1
               If Round(AH, 14) >= 1 Then G = Round(AH, 14) * 24 + 1 Else G = VBA.Hour(AH) + 1
               If Round(AI, 14) >= 1 Then H = Round(AI, 14) * 24 + 1 Else H = VBA.Hour(AI) + 1
        End Select
        Application.EnableEvents = True
        ActiveSheet.Protect
    End If
    Set AG = Nothing
    Set AH = Nothing
    Set AI = Nothing
    Set F = Nothing
    Set G = Nothing
    Set H = Nothing

End Sub


______________________________________________________________
C'è chi fa le COSE a CASO e chi fa CASO alle COSE (Ignoto)
trittico69
Post: 202
Registrato il: 02/04/2010
Città: MILANO
Età: 54
Utente Junior
2002
OFFLINE
06/02/2018 09:31
00#77
Ho selezionato la colonna “A” in tutti i fogli e formato celle-riempimento-colore sfondo-nessun colore-ok
Ma mi da lo stesso problema e cioè scrivendo 2 ad es. in J23 mi esce il messaggio box…dove sbaglio?

Nel foglio riep il codice collegato al tasto 1 “scopri righe e togli protezione” quando lo schiaccio mi va sempre al foglio NOV non riesco a capire il perché.

per quando riguarda il codice minuti se scrivo i servizi giorno per giorno funziona ma se faccio due settimane uguali e quindi la copio intera, per non riscrivere passo passo tutta la settimana es:B23:J38 e lo incollo piu giu non funziona...
grazie
[Modificato da trittico69 06/02/2018 09:45]
excel 2003
rollis13
Post: 645
Registrato il: 16/08/2015
Città: CORDENONS
Età: 67
Utente Senior
Excel 2016-32bit Win11
OFFLINE
06/02/2018 23:01
00#78
Se dopo aver ripulito la colonna A ti viene ancora segnalata l'incongruenza significa semplicemente che non hai fatto bene il lavoro. Per togliere il Colore riempimento puoi anche usare l'apposita icona nella Barra dei menu.

Il fatto che sia attivo il foglio NOV non è molto importante dato che sicuramente dipende da qualche altra macro che si attiva. Ma perché non fai un po' di debug e vedi come girano le macro. Ti basta impostare degli stop nei punti strategici premendo l' F9 dopo aver selezionato la riga della macro; quando la macro si ferma poi procedi passo passo con l' F8 e vedi come e dove agisce la macro. A volte è un lavoro noioso ma spetta a te che hai progettato la macro, non a noi.

Inoltre, nella macro che cancella (Macro1) non disattivi/attivi la protezione del foglio e non gestisci gli eventi con Application.EnableEvents = False/True per evitare di innescare inutilmente la macro Workbook_SheetChange.

Per quanto riguarda il fatto che se cambi una singola cella la macro minuti si attiva mentre se fai Copia/Incolla non si attiva, beh, qui si torna ad un simile problema trattato in precedenza (post #39 e successivi), ovvero, o fai un controllo mirato o fai Copia/Incolla, non tutt'e due insieme. In questo caso bisogna riprogettare quasi tutte le macro in modo da prevederlo dato che non è più possibile gestire l'evento Workbook_SheetChange ed al suo posto bisogna attivare di volta in volta un aggiornamento sistematico dell'intero foglio.
[Modificato da rollis13 06/02/2018 23:05]

______________________________________________________________
C'è chi fa le COSE a CASO e chi fa CASO alle COSE (Ignoto)
trittico69
Post: 203
Registrato il: 02/04/2010
Città: MILANO
Età: 54
Utente Junior
2002
OFFLINE
07/02/2018 07:41
00#79
ok sono riuscito a sistemare le colonne "A" di tutti i fogli.non so perchè ma facendo dalla barra del menu, come hai suggerito tu, è andato bene.
per quando riguarda il codice collegato al tasto 1 che mi porta a novembre ho messo questo rigo Sheets("RIEP").Select in modo che mi lascia nel foglio riep quando attivo la macro, anche se mi ha messo un dubbio: non è che qualche macro si ferma a novembre e non mi calcola il foglio DIC?
perchè siccome il foglio Riep è allinizio se qualche macro parte dal primo foglio quando arriva a NOV ha contato 12 fogli contatnto Riep come primo foglio.
per quanto riguarda il controllo delle macro con F9 e F8 non ci sono riuscito. forse troopo complicato per me.


La macro1 non ha bisogno di attivare/disattivare la protezione foglio perché viene attivata manualmente solo dopo aver attivato la macro rettangolo7 e successivamente, sempre manualmente, attivo la macro nascondi righe vuote che riattiva la protezione.
Poi se pui dirmi se la macro va modificata in questo modo

Sub Macro1() 'cancella i dati e commenti in tutti i mesi
Application.ScreenUpdating = False
Dim wb As Workbook
Dim R As Integer
Set wb = ThisWorkbook
wb.Sheets("RIEP").Range("C2,C3,C4,C5,C7").FormulaR1C1 = "0"
For R = 2 To 13
With wb.Sheets(R).Range("B14:J56,j12,i12")
.ClearContents
.ClearComments
wb.Sheets(R).Range("j12,i12,m12,O12,F10,G10,H10,o9,bg13,bh13").ClearContents
End With
Next R
Set wb = Nothing
Application.ScreenUpdating = True
End Sub



O cosi




Sub Macro1() 'cancella i dati e commenti in tutti i mesi
Dim wb As Workbook
Dim R As Integer
Application.ScreenUpdating = False
Set wb = ThisWorkbook
wb.Sheets("RIEP").Range("C2,C3,C4,C5,C7").FormulaR1C1 = "0"
For R = 2 To 13
With wb.Sheets(R).Range("B14:J56,j12,i12")
.ClearContents
.ClearComments
wb.Sheets(R).Range("j12,i12,m12,O12,F10,G10,H10,o9,bg13,bh13").ClearContents
End With
Next R
Set wb = Nothing
Application.ScreenUpdating = True
End Sub


si puo fare allora quanto sotto o è un lavoro troppo lungo che ti richiede tempo?
"Per quanto riguarda il fatto che se cambi una singola cella la macro minuti si attiva mentre se fai Copia/Incolla non si attiva, beh, qui si torna ad un simile problema trattato in precedenza (post #39 e successivi), ovvero, o fai un controllo mirato o fai Copia/Incolla, non tutt'e due insieme. In questo caso bisogna riprogettare quasi tutte le macro in modo da prevederlo dato che non è più possibile gestire l'evento Workbook_SheetChange ed al suo posto bisogna attivare di volta in volta un aggiornamento sistematico dell'intero foglio. "
[Modificato da trittico69 07/02/2018 09:42]
excel 2003
rollis13
Post: 646
Registrato il: 16/08/2015
Città: CORDENONS
Età: 67
Utente Senior
Excel 2016-32bit Win11
OFFLINE
07/02/2018 18:57
00#80
Ad analizzare le macro (in modo sbrigativo) sembra che tutti i fogli dei mesi vengono trattati. Come sicuramente avrai verificato nel VBA i fogli dei mesi sono numerati dal 2 al 13 e le macro, dove è stato sfruttato tale numero per identificare i fogli (es. Rettangolo7_Clic+Macro1 (ma non potevi chiamarle semplicemente Scopri+Cancella)), li comprendono.

Spostare la riga "Application.ScreenUpdating" due righe più in giù in quel punto della macro non cambia la sostanza. Potrebbe cambiare se la mette all'interno di un If/Then o un Loop con condizioni che se valide "passano oltre". In ogni caso non è una funzione importante, serve solo per evitare di vedere lo schermo sfarfallare ed aggiornarsi mentre le macro sono all'opera. Molto più importante è la funzione "Application.EnableEvents" che gestisce il controllo degli Eventi che serve ad attivare altre macro.

Per quanto riguarda l'ultima parte del post, a parte il fatto che non mi metterei mai a "fare macro" per un progetto che non conosco a fondo (al massimo aggiusto o rattoppo quello per cui altri chiedono aiuto), suggerisco che, secondo me, avrai bisogno di creare un loop che controlli tutte le righe del foglio e che inneschi le varie macro che servono per i controlli (es. minuti+Workbook_SheetChange) dato che quando fai Copia/Incolla il sistema non ha idea di quali e quante righe intendi copiare. Ovvero, dato che per ovvii motivi alcune parti delle macro vengono inibite in caso di gestione di più celle, dovrai a comando, fare eseguire sull'intero foglio quanto prevedono le macro in caso di gestione di una singola cella.
[Modificato da rollis13 07/02/2018 22:26]

______________________________________________________________
C'è chi fa le COSE a CASO e chi fa CASO alle COSE (Ignoto)
trittico69
Post: 204
Registrato il: 02/04/2010
Città: MILANO
Età: 54
Utente Junior
2002
OFFLINE
07/02/2018 20:07
00#81
E cosa dovrei fare per l'ultimo punto
excel 2003
rollis13
Post: 647
Registrato il: 16/08/2015
Città: CORDENONS
Età: 67
Utente Senior
Excel 2016-32bit Win11
OFFLINE
07/02/2018 23:45
00#82
Ti ho già esposto il mio pensiero nell'ultimo paragrafo (a parte la prima parte della prima riga). Con un po' di pazienza riconverti le attuali macro togliendo gli automatismi d'avvio/innesco e le associ ad un pulsante statico, quando hai finito di fare Copia/Incolla (o un semplice input) clicchi il pulsante che avvierà la tua macro che dovrà elaborare tutte le righe del mese in un passaggio solo anziché ad ogni input.

______________________________________________________________
C'è chi fa le COSE a CASO e chi fa CASO alle COSE (Ignoto)
trittico69
Post: 205
Registrato il: 02/04/2010
Città: MILANO
Età: 54
Utente Junior
2002
OFFLINE
08/02/2018 09:02
00#83
ok capito... si potrebbe fare invece che se il valore in M8 varia si attiva la macro in questione? viso che quel valore cambia anche incollanto piu celle!
tipo questa che però non va

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) = "m8" Then
Call minuti
End If
End Sub
lo messa in un foglio ma non va...probabilmente perchè nella cella c'è una formula
allora ho provato questa ma nulla di fatto
Dim oldm8
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("m8").Precedents) Is Nothing And _
Range("m8").Value <> oldm8 Then
Call minuti
oldm8 = Range("m8").Value
End If
End Sub



poi ho provato cosi ma nulla

Option Explicit


Dim oldm8
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("m8").Precedents) Is Nothing And _
Range("m8").Value <> oldm8 Then
Call minuti
oldm8 = Range("m8").Value



Sub minuti() ' questo codice si avvia con il rigo fine call minuti che si trova nel this workbook

Dim AG As Range
Dim AH As Range
Dim AI As Range
Dim F As Range
Dim G As Range
Dim H As Range

Set AG = ThisWorkbook.ActiveSheet.Range("AG31")
Set AH = ThisWorkbook.ActiveSheet.Range("AH31")
Set AI = ThisWorkbook.ActiveSheet.Range("AI31")
Set F = ThisWorkbook.ActiveSheet.Range("F10")
Set G = ThisWorkbook.ActiveSheet.Range("G10")
Set H = ThisWorkbook.ActiveSheet.Range("H10")
If ActiveSheet.Name <> "RIEP" And ActiveSheet.Name <> "codici servizi" Then
ActiveSheet.Unprotect
Application.EnableEvents = False
Select Case True
'SE LA SOMMA DEI MINUTI DELLE 3 CELLE SONO MINORI O UGUALI A 30 NON FARE NULLA
Case VBA.Minute(AG) + VBA.Minute(AH) + VBA.Minute(AI) <= 30
If Round(AG, 14) >= 1 Then F = Round(AG, 14) * 24 Else F = VBA.Hour(AG)
If Round(AH, 14) >= 1 Then G = Round(AH, 14) * 24 Else G = VBA.Hour(AH)
If Round(AI, 14) >= 1 Then H = Round(AI, 14) * 24 Else H = VBA.Hour(AI)
Case VBA.Minute(AG) = 0 _
And VBA.Minute(AH) > 30 _
And VBA.Minute(AI) > 30 _
And VBA.Minute(AH) + VBA.Minute(AI) < 90
If Round(AG, 14) >= 1 Then F = Round(AG, 14) * 24 Else F = VBA.Hour(AG)
If Round(AH, 14) >= 1 Then G = Round(AH, 14) * 24 Else G = VBA.Hour(AH)
If Round(AI, 14) >= 1 Then H = Round(AI, 14) * 24 + 1 Else H = VBA.Hour(AI) + 1
Case VBA.Minute(AG) = 0 _
And VBA.Minute(AH) > 30 _
And VBA.Minute(AI) > 30 _
And VBA.Minute(AH) + VBA.Minute(AI) > 90
If Round(AG, 14) >= 1 Then F = Round(AG, 14) * 24 Else F = VBA.Hour(AG)
If Round(AH, 14) >= 1 Then G = Round(AH, 14) * 24 + 1 Else G = VBA.Hour(AH) + 1
If Round(AI, 14) >= 1 Then H = Round(AI, 14) * 24 + 1 Else H = VBA.Hour(AI) + 1
'SE LA SOMMA DEI MINUTI DELLA 1ª E 2ª CELLA SONO MAGGIORI DI 30,
'MA MINORE O UGUALE A 90 E I MINUTI DELLA 1ª CELLA SONO
'MAGGIORI O UGUALI ALLA 2ª CELLA INCREMENTA LA 1ª CELLA DI 1 ORA
Case VBA.Minute(AG) > 0 _
And VBA.Minute(AH) > 0 _
.....................
......................
[Modificato da trittico69 08/02/2018 15:02]
excel 2003
rollis13
Post: 648
Registrato il: 16/08/2015
Città: CORDENONS
Età: 67
Utente Senior
Excel 2016-32bit Win11
OFFLINE
08/02/2018 23:23
00#84
Se ritieni che M8 sia una cella significativa per gestire la macro minuti in modo più "agile" potresti, da utilizzare nei fogli, usare qualcosa come:
Option Explicit
Dim oldM8

Private Sub Worksheet_Calculate()

    If oldM8 <> Range("M8").Value Then
        oldM8 = Range("M8").Value
        Call Minuti
    End If

End Sub

______________________________________________________________
C'è chi fa le COSE a CASO e chi fa CASO alle COSE (Ignoto)
trittico69
Post: 206
Registrato il: 02/04/2010
Città: MILANO
Età: 54
Utente Junior
2002
OFFLINE
09/02/2018 08:21
00#85
Sembra andare bene.
Grazie
excel 2003
trittico69
Post: 207
Registrato il: 02/04/2010
Città: MILANO
Età: 54
Utente Junior
2002
OFFLINE
12/02/2018 09:01
00#86
rollis nelle colonne c14:j50 non mi permette più di inserire i commenti, cosa che prima non succedeva.
E poi si potrebbe fare in modo che se faccio partire la macro 1, che si trova nel modulo 1, prima di aver fatto partire la macro “sub rettangolo”, anch’essa nel modulo 1, mi esca un messaggio box , invece che un messaggio di errore, che dica “ non puoi cancellare i dati se prima non togli la protezione cliccando sul tasto 1
[Modificato da trittico69 12/02/2018 10:52]
excel 2003
rollis13
Post: 652
Registrato il: 16/08/2015
Città: CORDENONS
Età: 67
Utente Senior
Excel 2016-32bit Win11
OFFLINE
12/02/2018 23:45
00#87
Per quanto riguarda i commenti non ho idea del perché, le ultime modifiche trattate nel forum nulla hanno a che fare con un problema simile; vedi quali altre modifiche hai apportato per valutare meglio il caso. Probabilmente hai semplicemente la protezione su quelle cella attiva e questo ti impedisce la completa gestione dei commenti.

Ma perché devi scervellarti a modificare e creare ulteriori messaggi ? Basta inserire direttamente nella macro Macro1 lo sblocco/blocco della protezione.
Semplicemente riscrivi questa parte della Macro1 così: 
...
For R = 2 To 13
    wb.Sheets(R).Unprotect
    With wb.Sheets(R).Range("B14:J56,J12,I12")
        .ClearContents
        .ClearComments
    End With
    wb.Sheets(R).Range("J12,I12,M12,O12,F10,G10,H10,O9,BG13,BH13").ClearContents
    wb.Sheets(R).Protect
Next R
...

Se poi la riscrivi così viene ancora meglio: 
...
For R = 2 To 13
    With Sheets(R)
        .Unprotect
        With .Range("B14:J56,J12,I12")
            .ClearContents
            .ClearComments
        End With
        .Range("J12,I12,M12,O12,F10,G10,H10,O9,BG13,BH13").ClearContents
        .Protect
    End With
Next R
...

[Modificato da rollis13 12/02/2018 23:58]

______________________________________________________________
C'è chi fa le COSE a CASO e chi fa CASO alle COSE (Ignoto)
trittico69
Post: 208
Registrato il: 02/04/2010
Città: MILANO
Età: 54
Utente Junior
2002
OFFLINE
13/02/2018 07:39
00#88
ma in questo modo se per sbaglio avvio la macro 1 cliccando sul tasto 2 del foglio "riep" mi cancella tutti i dati
excel 2003
rollis13
Post: 653
Registrato il: 16/08/2015
Città: CORDENONS
Età: 67
Utente Senior
Excel 2016-32bit Win11
OFFLINE
13/02/2018 17:17
00#89
Vabbè, se è proprio un messaggio che vuoi aggiungi queste poche righe di codice subito dopo i Dim: 
Dim avviso As String

avviso = MsgBox("Stai per ripulire il foglio," & vbLf _
    & "è proprio quello che ti proponevi di fare ?", _
    vbYesNo + vbExclamation, "Pulitura Foglio")
If avviso = vbNo Then Exit Sub

______________________________________________________________
C'è chi fa le COSE a CASO e chi fa CASO alle COSE (Ignoto)
trittico69
Post: 209
Registrato il: 02/04/2010
Città: MILANO
Età: 54
Utente Junior
2002
OFFLINE
14/02/2018 07:46
00#90
questo è la macro che ho messo ma confermando di voler cancellare i dati senza premere il tasto 1 e quindi far partire la macro sub rettangolo 7 mi da errore questa riga

.Range("J12,I12,M12,O12,F10,G10,H10,O9,BG13,BH13").ClearContents 



Sub Macro1() 'cancella i dati e commenti in tutti i mesi

Dim wb As Workbook
Dim R As Integer
Dim avviso As String
avviso = MsgBox("Stai per ripulire il foglio," & vbLf _
    & "è proprio quello che ti proponevi di fare ?", _
    vbYesNo + vbExclamation, "Pulitura Foglio")
If avviso = vbNo Then Exit Sub
Set wb = ThisWorkbook

wb.Sheets("RIEP").Range("C2,C3,C4,C5,C7").FormulaR1C1 = "0"
For R = 2 To 13
    With Sheets(R)
        .Unprotect
        With .Range("B14:J56,J12,I12")
            .ClearContents
            .ClearComments
        End With
        .Range("J12,I12,M12,O12,F10,G10,H10,O9,BG13,BH13").ClearContents
        .Protect
         .Protect DrawingObjects:=False, Contents:=True, Scenarios:=True
    End With
Next R

Set wb = Nothing
Sheets("RIEP").Select
End Sub


ho provato a togliere
.Protect
e mi da errore alla prima riga del seguente codice 
If Not Intersect(Target, [I14:I57]) Is Nothing Then
            If Range("I" & R) = 2 Or Range("I" & R) = 3 Or Range("I" & R) = 4 Then
                MsgBox "Qui va messo solo codice presenza"
                Application.EnableEvents = False
                Target.ClearContents
                Application.EnableEvents = True
            End If
        End If
[Modificato da trittico69 14/02/2018 07:50]
excel 2003
Vota:
Nuova Discussione
 | 
Rispondi
Cerca nel forum
Cerca
nei titoli, nei messaggi, con Google
Tag discussione
messaggio errore con due celle
Discussioni Simili   [vedi tutte]
Feed | Forum | Bacheca | Album | Utenti | Cerca | Login | Registrati | Amministra
Tutti gli orari sono GMT+01:00. Adesso sono le 21:48. Versione: Stampabile | Mobile | Regolamento | Privacy
FreeForumZone [v.6.1] - Copyright © 2000-2024 FFZ srl - www.freeforumzone.com

  • Anteprima