Differenza tra date se interv celle contiene dati

Hai un problema con Excel?

Nuova discussione

Differenza tra date se interv. celle contiene dati
di TommyPuffo89 (utente non iscritto) data: 08/01/2017 14:43:40
Salve a tutti, non so se sto inserendo la mia richiesta nel posto giusto ma ho un URGENTE BISOGNO DI VOI!!! E' in palio la conferma del mio posto di lavoro!!!

Io ho inserito nella cella B1 una data x. Nelle celle sottostanti tale data potrei avere delle attività in programma (supponiamo dalla cella B2 alla B10).
Avrei bisogno di un pop-up che all'apertura del mio file Excel mi faccia in automatico la differenza tra questa data X posta nella cella B1 e la data corrente solo se nell'intervallo di celle B2:B10 ho inserito delle attività in programma. Se in questo intervallo B2:B10 tutte le celle sono vuote il pop-up non deve essere mostrato.
Inoltre il pop-up deve essere mostrato solo se la data x della cella B1 è lontana meno di 8 giorni dalla data corrente.

Il codice da me creato è il seguente ed è funzionante. Il problema è che per quanto riguarda l'intervallo B2:B10 mi considera solo la cella B2. Come dovrei correggere il mio programmino per considerare l'intero intervallo?
Un enorme grazie a chi mi aiuterà a trovare la soluzioneeee!!!

Sub Auto_Open()
Dim TheDate As Date
Dim Msg
If [B2]<> "" Then
TheDate = [B1]
If DateDiff("d", Now, TheDate) < 8 Then
Msg = "Giorni rimanenti: " & DateDiff("d", Now, TheDate)
MsgBox Msg
End If
End If
End Sub

di Albatros54 data: 08/01/2017 16:05:02
prova cosi.
Ciao
Albatros54

Sub Auto_Open()
Dim TheDate As Date
Dim Msg
Dim rng As Range
Set rng = Range("b2:b10")
For Each cl In rng
If [B2] <> "" Then
TheDate = cl
If DateDiff("d", Now, TheDate) < 8 Then
Msg = "Giorni rimanenti: " & DateDiff("d", Now, TheDate)
MsgBox Msg
End If
End If
Next
End Sub

di TommyPuffo89 (utente non iscritto) data: 08/01/2017 16:13:55
Grazie 1000 ma mi da un pop-up per ogni cella mentre a me servirebbe un pop-up solo se è presente uno o più valori all'interno dell'intervallo B2:B10. Inoltre mi dice -42743 giorni rimanenti ed è impossibile dato che la differenza di data è di soli 4 giorni.
Hai qualche idea per modificare il tuo codice?
di TommyPuffo89 (utente non iscritto) data: 08/01/2017 16:19:25
Ho anche allegato il file.
Lo stesso lavoro dovrei farlo anche per quanto riguarda le colonne C e D ma se riusciamo a risolvere il rebus relativo alla colonna A potrei applicare la macro anche alle altre colonne.
Grazie 1000 della disponibilità.

di Albatros54 data: 08/01/2017 16:47:14
prova cosi

Sub Auto_Open()
Dim TheDate As Date
Dim Msg
Dim rng As Range
Set rng = Range("b2:b10")
For Each cl In rng
If [B1] <> "" Then
TheDate = cl
If DateDiff("d", Now, TheDate) < 8 Then
Msg1 = "Giorni rimanenti: " & DateDiff("d", Now, TheDate)
Msg = Msg & vbCrLf & Msg1
End If
End If
Next
MsgBox Msg
End Sub

di TommyPuffo89 (utente non iscritto) data: 08/01/2017 16:52:38
Esce scritto "errore di run-time '13'" ed al debug mi colora in giallo la parte "TheDate = cl".
Dici che si può risolvere?
di Albatros54 data: 08/01/2017 16:58:19
scenario: seleziona le celle dalla B1 fino alla B12, "formato data",
introduci delle date dalla cella B1 fino alla B12, e lanci il codice , non dovrebbe andare in errore, sel nelle celle non c'è una data , ma bensi una stringa il codice va in errore.

di TommyPuffo89 (utente non iscritto) data: 08/01/2017 17:05:40
Nell'intervallo b2:b10 non devo inserire della date ma delle attività. Il mio primissimo codice che ho caricato su questo form funzionava alla grande ma solo per la cella B2. La soluzione potrebbe essere quella di creare al primo if qualcosa del genere:

If [B2:B10] <> "" Then

Il problema è questa istruzione è sintatticamente errata. I ho bisogno di includere questo intervallo anzicchè la sola cella B2. Per il resto era tutto funzionante.
Ti riposto il codice caricato inizialmente.

Credo che grazie al tuo aiuto siamo vicini alla soluzione...

Sub Auto_Open()
Dim TheDate As Date
Dim Msg
If [B2]<> "" Then
TheDate = [B1]
If DateDiff("d", Now, TheDate) < 8 Then
Msg = "Giorni rimanenti: " & DateDiff("d", Now, TheDate)
MsgBox Msg
End If
End If
End Sub

di Albatros54 data: 08/01/2017 17:14:14
Forse ho capito!!!!

Public Sub b()
Dim TheDate As Date
Dim Msg
Dim rng As Range
Set rng = Range("b2:b10")
For Each cl In rng
If cl <> "" Then
TheDate = [B1]
If DateDiff("d", Now, TheDate) < 8 Then
Msg1 = "Giorni rimanenti: " & DateDiff("d", Now, TheDate)
Msg = Msg & vbCrLf & Msg1
End If
End If
Next
MsgBox Msg
End Sub

di TommyPuffo89 (utente non iscritto) data: 08/01/2017 17:28:53
Grande! Abbiamo quasi risolto:

Le due cose che la macro non dovrebbe fare sono le seguenti:
- Far uscire il pop- up quando l'intervallo di celle è vuoto;
- Far uscire il pop-up con la scritta dei giorni rimanenti sono una volta indipendentemente dal numero di celle riempite nell'intervallo b2:b10. Cioè se le celle riempite sono per es. 3 il numero dei giorni rimanenti dovrebbe uscire solo una volta nel Msgbox e non 3 volte. Spero di essermi spiegato.
di TommyPuffo89 (utente non iscritto) data: 08/01/2017 17:30:44
Comunque sei davvero bravo, complimenti!!

di Albatros54 data: 08/01/2017 17:39:06

Public Sub b()
Dim TheDate As Date
Dim Msg
Dim rng As Range
Dim a As Integer
a = 0
Set rng = Range("b2:b10")
For Each cl In rng
If cl <> "" Then
a = a + 1
TheDate = [b1]
If DateDiff("d", Now, TheDate) < 8 Then
Msg = "Giorni rimanenti: " & DateDiff("d", Now, TheDate)
End If
End If
Next
If a <> 0 Then
MsgBox Msg
End If
End Sub

di TommyPuffo89 (utente non iscritto) data: 08/01/2017 17:48:44
Grandissimooo!!! Funziona quasi tutto alla perfezione!!!

Un'ultima cosa però ho notato: se io nella cella B1 dovessi inserire una data lontana più di 8 giorni da quella corrente, in caso nell'intervallo b2:b10 non ci dovessero essere valori scritti mi da ancora il pop-up vuoto. In questo caso a me non serve visualizzare alcun pop-up indipendentemente se nell'intervallo b2:b10 ci sia scritto qualcosa o meno. Spero di essere stato chiaro.
Pensi do poter risolvere anche questa cosa?
Grazie infinite fino ad ora.
di TommyPuffo89 (utente non iscritto) data: 08/01/2017 18:14:39
Come posso ringraziarti per l'enorme aiuto che mi hai dato?
di TommyPuffo89 (utente non iscritto) data: 09/01/2017 21:33:40
Albatro54, sei riuscito a dare un'occhiatina su come poter risolvere il mio ultimo quesito?
Grazie in anticipo.

di pregiudicato_83 (utente non iscritto) data: 09/01/2017 22:57:52
Ciao, non so se ho capito bene (perché son un po di fretta)
comunque mi sembra che cosi può andare.
l'unica cosa che se metti una data antecedente a oggi, nell'avviso ti darà i giorni in negativo.
ma sono sicuro che questa parte saprai gestirla nel caso non ti vada bene.

ciao

Public Sub Auto_Open()
Dim ATTIVITA As Boolean
ATTIVITA = False

    For Each cl In [B2:B10]
        If cl <> "" Then ATTIVITA = True: Exit For
    Next
    
    If ATTIVITA = True And DateDiff("d", Now, [B1]) < 8 Then
        MsgBox "Giorni rimanenti: " & DateDiff("d", Now, [B1])
    End If
End Sub

di TommyPuffo89 (utente non iscritto) data: 11/01/2017 11:25:18
Wow! Funziona!!
L'unica cosa che non va bene è però quella che hai già menzionato tu e cioè quella della differenza di giorni negativa. Non si potrebbe fare l'"If ATTIVITA" con un intervallo compreso tra > -1 e < 8?
Comunque grazie 1000, hai centrato in pieno ciò che mi serviva! Se riusciamo a trovare la soluzione a quest'ultimo problemino il gioco sarà fatto.

di TommyPuffo89 (utente non iscritto) data: 12/01/2017 11:29:42
Ragazzi dovrei aver risolto:
Il codice potrebbe essere quello in basso:

Un'ultimissima cosa però: con questo codice sto esaminando solo una data (quella in B1) rispetto a quella corrente ma se io volessi valutare tutti i giorni dell'anno rispetto alla data corrente dovrei copiare questo codice per altre 364 volte? Oppure posso inserire qualcosa all'interno di questo codice che mi possa far evitare questo?
Grazie 1000 in anticipo!!! Dopo aver risolto quest'ultimo quesito credo che il programmino potrebbe anche considerarsi risolto.

Public Sub Auto_Open() 
Dim TheDate As Date 
Dim Msg As String 
Dim cella As Range 

With Sheets("Foglio1") 'nome tuo foglio 
TheDate = CDate(.Range("B1")) 
If TheDate > Date Then 
For Each cella In .Range("B2:B10") 
If cella <> "" Then 
If DateDiff("d", Now, TheDate) < 8 Then 
Msg = "Giorni rimanenti: " & DateDiff("d", Now, TheDate) 
MsgBox Msg 
Exit For 
End If 
End If 
Next cella 
End If 
If TheDate = Date Then 
For Each cella In .Range("B2:B10") 
If cella <> "" Then 
If DateDiff("d", Now, TheDate) < 8 Then 
Msg = "Giorni rimanenti: " & DateDiff("d", Now, TheDate) 
MsgBox Msg 
Exit For 
End If 
End If 
Next cella 
End If 
End With 
End Sub

di TommyPuffo89 (utente non iscritto) data: 12/01/2017 11:30:50
Per esempio, oltre a farmi uscire il pop-up per la data in B1 considerando l'intervallo di celle B2:B10, mi servirebbe far uscire il pop-up per la data in C1 con intervallo di celle C2:C10 e così via per tutti i giorni dell'anno.
Dovrei copiare il codice per un totale di 365 volte? Spero davvero di no...
Come possiamo aggiustare il nostro programmino?

di TommyPuffo89 (utente non iscritto) data: 14/01/2017 14:48:54
Questa è l'ultima versione della macro che ho fatto su cui applicare le modifiche richieste:

Public Sub Auto_Open()
Dim TheDate As Date
Dim Msg As String
Dim cella As Range



With Sheets("Foglio1") 'nome tuo foglio
    TheDate = CDate(.Range("B1"))


If TheDate >= Date Then
        For Each cella In .Range("B2:B10")
            If cella <> "" Then
                If DateDiff("d", Now, TheDate) = 0 Then
                    Msg = "ATTENZIONE! Hai dei clienti che usufruiranno di un servizio tra:  " & DateDiff("d", Now, TheDate) & " giorni"
                    MsgBox Msg
                    Exit For
                End If
            End If
        Next cella
    End If
    
If TheDate >= Date Then
        For Each cella In .Range("B2:B10")
            If cella <> "" Then
                If DateDiff("d", Now, TheDate) = 1 Then
                    Msg = "ATTENZIONE! Hai dei clienti che usufruiranno di un servizio tra:  " & DateDiff("d", Now, TheDate) & " giorno"
                    MsgBox Msg
                    Exit For
                End If
            End If
        Next cella
    End If

    If TheDate >= Date Then
        For Each cella In .Range("B2:B10")
            If cella <> "" Then
                If DateDiff("d", Now, TheDate) = 0 And DateDiff("d", Now, TheDate) > 1 And DateDiff("d", Now, TheDate) < 8 Then
                    Msg = "ATTENZIONE! Hai dei clienti che usufruiranno di un servizio tra:  " & DateDiff("d", Now, TheDate) & " giorni"
                    MsgBox Msg
                    Exit For
                End If
            End If
        Next cella
    End If
 
        
End With
End Sub

di TommyPuffo89 (utente non iscritto) data: 14/01/2017 14:49:55
Grazie in anticipo a chi mi darà una mano.

Vuoi Approfondire?