Sostieni Excel VBA con una donazione! Con la tua donazione potrai contribuire al mantenimento del servizio.
Le donazioni sono eseguite con PayPal, il modo più facile, comodo e sicuro per pagare online.
Paypal accetta anche carta di credito o carte prepagate.

Differenza tra date se interv. celle contiene dati

  • FILE ALLEGATI:
  • Differenza tra date se interv. celle contiene dati (Excel 2010) 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 (Utente esperto) 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 (Utente esperto) 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 (Utente esperto) 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 (Utente esperto) 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 (Utente esperto) 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.
  • torna su

Sostieni Excel VBA con una donazione! Con la tua donazione potrai contribuire al mantenimento del servizio.
Le donazioni sono eseguite con PayPal, il modo più facile, comodo e sicuro per pagare online.
Paypal accetta anche carta di credito o carte prepagate.