Verifica condizioni Cella con Date

[FROST220684Partecipante FROST220684]

Ciao a tutti,

ho provato a cercare in rete vedendo alcuni esempi con l'evento Change ma non riesco a capire come impostarli.

Faccio un esempio del mio problema:

Mi trovo spesso a scrivere date manualmente riferendomi all'anno successivo. Ad esempio adesso che è il 2024 le mie date di lavoro corrispondono al 2025 ma se in excel scrivo solo il giorno ed il mese in automatico mi viene assegnato il 2024 come anno mentre a me serve il 2025. C'è un modo per dire se in quella cella B6 compare il 2024 trasforma in 2025?

Altro Problema:

Avendo un Range date in 2 celle diverse avrei bisogno di controllare che il numero di giorni tra queste due celle sia uguale al valore presente in un altra cella ad esempio:

B6 = 30/05/2025

B7 = 02/06/2025

E7= 4

Effettivamente dal 30/05/2025 al 02/06/2025 sono 4 giorni, avrei bisogno che quando lancio una specifica macro prima che questa venga lanciata mi controlli che la differenza tra le date sia corretta con il valore in E7.

Allego un semplice file con i dati da verificare

Grazie mille se qualcuno mi darà una mano

Allegati:

You must be logged in to view attached files.

[Raffaele53Partecipante Raffaele53 Karma: 23 pts]

A riguardo la data premi ALT+F11 ed incolla

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("C4")) Is Nothing Then
        If IsDate(Target) Then
            Application.EnableEvents = False
            Target = DateSerial(Year(Target) + 1, Month(Target), Day(Target))
            Application.EnableEvents = True
        End If
    End If
End Sub

A riguardo il confronto, nella Tua macro inserici come prima riga

If DateDiff("d", Range("B6"), Range("B7")) + 1 <> Range("E7") Then MsgBox "Date non valide,esco": Exit Sub

[FROST220684Partecipante FROST220684]

Ciao Raffaele e Grazie della risposta. 

Funziona tutto l'unico problema è se per sbaglio inserisco io la data corretta è quindi 30/05/2025 in questo modo il codice passa direttamente al 2026, si potrebbe aggiungere qualcosa che porta alla situazione inversa?

Per farti capire meglio, sicuramente mi sono spiegato male, il mio anno di riferimento è il 2025 e quindi ogni data scritta deve ricadere nel 2025

Un'altro problema è che lanciando una macro che salva un file in xlsx mi chiede ogni volta se voglio salvare un file con macro attive mentre prima salvava il file e basta, immagino che sia dovuto alla presenza del codice in foglio1, è possibile bypassare la cosa dicendo al codice quando salvi il file xlsx non chiedere questa cosa, oppure nel file xlsx non portare dietro il codice vba.

Grazie mille dell'aiuto

 

[FROST220684Partecipante FROST220684]

giusto per farti capire meglio, quando lancio una macro che prevede questo codice: 

wb2.Worksheets("Input").Range("N46") = "Preventivo creato il " & Date
    wb2.SaveAs p & "\1 PREVENTIVI E VOUCHER\PREVENTIVI EXCEL\" & Replace(s, "/", "-") & ".xlsx", FileFormat:=xlWorkbookDefault
    For Each v In wb2.LinkSources(Type:=xlLinkTypeExcelLinks)
        wb2.BreakLink Name:=v, Type:=xlLinkTypeExcelLinks

Mi chiede se voglio o meno salvare un file con macro attive, ma a me serve che salvi il file in xlsx senza lanciarmi ogni volta l'avviso.

[Raffaele53Partecipante Raffaele53 Karma: 23 pts]

Ok, mà a gennaio-2025 dovrai cambiare l'anno, sostituisci la riga If IsDate(Target) Then

If IsDate(Target) And Year(Target) = 2024 Then

Per non visualizzare il msg, devi mettere prima e dopo della riga

Application.DisplayAlerts = False
wb2.Worksheets("Input").Range("N46")......
Application.DisplayAlerts = True

 

[FROST220684Partecipante FROST220684]

diciamo che funziona tutto l'unico problema è che quando lancio questa macro mi da un debug quando riparte il foglio.

Quando lancio questo:

Option Explicit



Sub save_as()
Dim p As String
Dim s As String
Dim v As Variant
Dim i As Integer, uRiga As Integer
Dim wb1 As Workbook
Dim wb2 As Workbook




    'inizio istruzioni cursore mouse
    With Application
        .ScreenUpdating = False
        .Cursor = xlWait
    End With
    
    Set wb1 = ThisWorkbook      'in wb1 imposto riferimento a questo foglio di lavoro
    Set wb2 = Workbooks.Add     'in wb2 imposto riferimento a nuovo foglio di lavoro
    p = "Z:\Altri computer\Il mio computer\Archivio\UFFICO BOOKING" 'inserire percorso cartelle preventivi
   ' p = "C:\Users\alebo\Downloads\Lavori in Excel\Preventivi"
    
    'variabile per salvataggio con nome
    s = "@A - @B - @C - @D"
    For i = 1 To 4
        v = Choose(i, "B3", "B1", "B6", "B7")
        s = Replace(s, "@" & Chr$(64 + i), wb1.Worksheets("Input").Range(v))
    Next
    ' inserire il nome della cartella preventivi excel al posto di Preventivi Excel
    wb1.Worksheets.Copy before:=wb2.Worksheets(1)
    'in cella N46 del foglio originale salvo data e ora di creazione del foglio copiato
    Application.DisplayAlerts = False
    wb2.Worksheets("Input").Range("N46") = "Preventivo creato il " & Date
    wb2.SaveAs p & "\1 PREVENTIVI E VOUCHER\PREVENTIVI EXCEL\" & Replace(s, "/", "-") & ".xlsx", FileFormat:=xlWorkbookDefault
    For Each v In wb2.LinkSources(Type:=xlLinkTypeExcelLinks)
        wb2.BreakLink Name:=v, Type:=xlLinkTypeExcelLinks
        Application.DisplayAlerts = True
    Next
      wb1.Worksheets("Input").Range("N70") = "No"
    wb1.SaveCopyAs p & "\1 PREVENTIVI E VOUCHER\PREVENTIVI EXCEL VBA\" & Replace(s, "/", "-") & ".xlsm"
    wb1.Worksheets("Input").Range("N45").Value = p & "\0 OPERATORI\Operatore 3\Preventivi PDF Operatore 3\" & Replace(s, "/", "-") & ".pdf"
        With Worksheets("Input")
        
        If .Range("E7") > 3 Then
    With wb2.Worksheets("Output")
        ' inserire il nome della cartella preventivi PDF al posto di Preventivi Excel
        .Select
        uRiga = .Cells(Rows.Count, "B").End(xlUp).Row
    
        .Range("$A$5:$D$65").AutoFilter Field:=4, Criteria1:="<>"
        With .PageSetup
            .PrintArea = "A1:D" & uRiga
            .Orientation = xlPortrait
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = False
        End With

        .ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=p & "\0 OPERATORI\Operatore 3\Preventivi PDF Operatore 3\" & Replace(s, "/", "-") & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
    End With

    wb2.Worksheets("Input").Select
    wb2.Close True  'salva e chiude il nuovo foglio creato
    
    With wb1.Worksheets("Input")
        ' inizio istruzioni di resettaggio celle
        .Range("B1,B2,B4,B5,B12:D12,B6:D6,E7,B8:D12,B20:D20,j2,J4:J6,J9,J11,M3,N45,D56,D57,D58,M7:M9").ClearContents
        .Range("B6:D6") = "5/30/2024"
        .Range("E7") = "7"
        .Range("B8:D8") = "2"
        .Range("B9:D9") = "1"
        .Range("A56:C56") = "Rigo personalizzabile"
        .Range("A57:C57") = "Rigo personalizzabile"
        .Range("A58:C58") = "Rigo personalizzabile"
         .Range("N70") = ""
        ' istruzione di aggiunta +1 al preventivo
        .Range("B3").Value = .Range("B3").Value + 1
    End With
    With UserForm1      'qui ovviamente ci vuole il nome dell'userform reale
    .CheckBox1 = False
    .CheckBox2 = False
    .TextBox1.Value = ""
    Call UserForm1.btnConferma_Click
    End With
    Call RipristinaFoglio
    Call BackupFoglio
   Call BackupFoglioOutput
   Call BackupFoglioOutputWeekend
 

Call ResetFoglio
    End If
    ThisWorkbook.Names("bShowUF").RefersTo = True
    'fine istruzioni cursore mouse
    With Application
        .ScreenUpdating = True
        .Cursor = xlDefault
    End With
   With Worksheets("Input")
        
        If .Range("E7") <= 3 Then
        With wb2.Worksheets("Output Weekend")
        ' inserire il nome della cartella preventivi PDF al posto di Preventivi Excel
        .Select
        uRiga = .Cells(Rows.Count, "B").End(xlUp).Row
    
        .Range("$A$5:$D$65").AutoFilter Field:=4, Criteria1:="<>"
        With .PageSetup
            .PrintArea = "A1:D" & uRiga
            .Orientation = xlPortrait
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = False
        End With

        .ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=p & "\0 OPERATORI\Operatore 3\Preventivi PDF Operatore 3\" & Replace(s, "/", "-") & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
    End With

    wb2.Worksheets("Input").Select
    wb2.Close True  'salva e chiude il nuovo foglio creato
    
    With wb1.Worksheets("Input")
        ' inizio istruzioni di resettaggio celle
        .Range("B1,B2,B4,B5,B12:D12,B6:D6,E7,B8:D12,B20:D20,j2,J4:J6,J9,J11,M3,N45,D56,D57,D58,M7:M9").ClearContents
        .Range("B6:D6") = "5/30/2024"
        .Range("E7") = "7"
        .Range("B8:D8") = "2"
        .Range("B9:D9") = "1"
        .Range("A56:C56") = "Rigo personalizzabile"
        .Range("A57:C57") = "Rigo personalizzabile"
        .Range("A58:C58") = "Rigo personalizzabile"
        .Range("N70") = ""
        ' istruzione di aggiunta +1 al preventivo
        .Range("B3").Value = .Range("B3").Value + 1
    End With
    With UserForm1      'qui ovviamente ci vuole il nome dell'userform reale
    .CheckBox1 = False
    .CheckBox2 = False
    .TextBox1.Value = ""
    Call UserForm1.btnConferma_Click
    End With
    Call RipristinaFoglio
    Call BackupFoglio
     Call BackupFoglioOutput
   Call BackupFoglioOutputWeekend
 
   
Call ResetFoglio
    End If
    ThisWorkbook.Names("bShowUF").RefersTo = True
    With Application
        .ScreenUpdating = True
        .Cursor = xlDefault
    End With
    
Set wb1 = Nothing: Set wb2 = Nothing
End With
End With
End Sub

mi succedono 2 cose: non viene eseguito il codice nella parte di reset:

With wb1.Worksheets("Input")
        ' inizio istruzioni di resettaggio celle
        .Range("B1,B2,B4,B5,B12:D12,B6:D6,E7,B8:D12,B20:D20,j2,J4:J6,J9,J11,M3,N45,D56,D57,D58,M7:M9").ClearContents
        .Range("B6:D6") = "5/30/2024"
        .Range("E7") = "7"
        .Range("B8:D8") = "2"
        .Range("B9:D9") = "1"
        .Range("A56:C56") = "Rigo personalizzabile"
        .Range("A57:C57") = "Rigo personalizzabile"
        .Range("A58:C58") = "Rigo personalizzabile"
        .Range("N70") = ""
        ' istruzione di aggiunta +1 al preventivo
        .Range("B3").Value = .Range("B3").Value + 1

e mi da un debug sulla riga che abbiamo cambiato: 

If IsDate(Target) And Year(Target) = 2024 Then

 

ti allego un file senza queste modifiche che abbiamo fatto tenendo conto che il modulo della macro che lancio è il modulo 1, mentre nel Foglio1 metto l'evento change

Allegati:

You must be logged in to view attached files.

[FROST220684Partecipante FROST220684]

ti aggiorno, inoltre che se lascio la riga:

 If IsDate(Target) Then

tutto funziona correttamente quindi non so che problema crea la riga che abbiamo modificato. Diciamo che con questa vecchia riga funziona tutto rimane solo il problema che se scrivo 30/05/25 me lo trasforma in 2026

 

[FROST220684Partecipante FROST220684]

Raffaele53 ha scritto:

If DateDiff("d", Range("B6"), Range("B7")) + 1 <> Range("E7") Then MsgBox "Date non valide,esco": Exit Sub

un'altra possibilità per farlo funzionare è un'ulteriore controllo che dice se in B6 trovi 2026 Then MsgBox "Date non valide,esco": Exit Sub

una cosa del genere non so se l'ho scritta bene

If Date(Range("B6") = 2026  Then MsgBox "Date non valide,esco": Exit Sub

[Raffaele53Partecipante Raffaele53 Karma: 23 pts]

Sul 1° allegato era colorata la cella C4, nel foglio "input" dove inserisci la data?
Aggiunto il codice e scritto in C4>>> 2/2 che diventa 02/02/2025 senza errori.

In Modulo1 vedo che hai messo Application.DisplayAlerts = True all'interno del ciclo For Each v In wb2....???

Non vedo la verifica in modulo1, comunque errore mio modificata e dopo provato
If Sheets("Input").Range("B6") + Sheets("Input").Range("e7") <> Sheets("Input").Range("B7") Then MsgBox "Date non valide,esco": Exit Sub

Si è fermato a \1 PREVENTIVI E VOUCHER\, directory che non ho sul PC. Il resto del codice non l'ho letto

>>>If Date(Range("B6") = 2026 Then
Ps. Errore, casomai If Year(Range("B6") = 2026 Then

Allegati:

You must be logged in to view attached files.

[FROST220684Partecipante FROST220684]

Raffaele53 ha scritto:

Sul 1° allegato era colorata la cella C4, nel foglio "input" dove inserisci la data?

errore mio in realtà è B6

Raffaele53 ha scritto:

In Modulo1 vedo che hai messo Application.DisplayAlerts = True all'interno del ciclo For Each v In wb2....???

l'ho messo lì in quanto è il punto in cui viene creato il file xlsx che da' l'errore messo cosi il msg non esce più.

Raffaele53 ha scritto:

Non vedo la verifica in modulo1, comunque errore mio modificata e dopo provato If Sheets("Input").Range("B6") + Sheets("Input").Range("e7") <> Sheets("Input").Range("B7") Then MsgBox "Date non valide,esco": Exit Sub

Si è fermato a \1 PREVENTIVI E VOUCHER\, directory che non ho sul PC. Il resto del codice non l'ho letto

>>>If Date(Range("B6") = 2026 Then
Ps. Errore, casomai If Year(Range("B6") = 2026 Then

Allora ti riallego il file con tutte le modifiche inserite,

funziona tutto l'unica cosa che non riesco a far funzionare è il problema dell'anno 2026

avevo pensato ad una cosa del genere sull'evento change ma non funziona:

uguale all'evento creato prima con il 2024 quindi fai + 1, mentre se inserisco il 2025 rimani cosi

oppure questo If Year(Range("B6") = 2026 Then MsgBox "Date non valide,esco": Exit Sub

ma non funziona

 

Allegati:

You must be logged in to view attached files.

[Raffaele53Partecipante Raffaele53 Karma: 23 pts]

>>>l'ho messo lì in quanto è il punto in cui viene creato il file xlsx
Per me devono stare prima della riga che salva files.xlsx e dopo

Scusa alle 14:40 c'era scritto>>>If IsDate(Target) And Year(Target) = 2024 Then
Alle 15:07 c'è scritto>>>If IsDate(Target) Then (non capisco perchè ci dovrebbe essere 2026?)

Con questo non hai più bisogno di modificarlo a fine anno. Metti 2030 o 2000, sarà sempre un'anno in più, anche negli anni futuri.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("B6")) Is Nothing Then
        If IsDate(Target) And Year(Target) <> Year(Date) + 1 Then
            Application.EnableEvents = False
            Target = DateSerial(Year(Date) + 1, Month(Target), Day(Target))
            Application.EnableEvents = True
        End If
    End If
End Sub

[FROST220684Partecipante FROST220684]

Raffaele53 ha scritto:

>>>l'ho messo lì in quanto è il punto in cui viene creato il file xlsx Per me devono stare prima della riga che salva files.xlsx e dopo

fatto

Raffaele53 ha scritto:

Scusa alle 14:40 c'era scritto>>>If IsDate(Target) And Year(Target) = 2024 Then Alle 15:07 c'è scritto>>>If IsDate(Target) Then (non capisco perchè ci dovrebbe essere 2026?)

cmq io non so cosa sia capitato a questo forum, una volta si cercava di dare una mano a prescindere anche a persone che ci capiscono poco e niente (e non tutti sono bravi o imparano facilmente come altri). non capisco che senso abbia contrabbattere con un stiamo giocando? secondo voi passo il tempo a giocare?

lo rispiego se qui non sono stato chiaro nella mia richiesta di aiuto:

FROST220684 ha scritto:

avevo pensato ad una cosa del genere sull'evento change ma non funziona:

uguale all'evento creato prima con il 2024 quindi fai + 1, mentre se inserisco il 2025 rimani cosi

oppure questo If Year(Range("B6") = 2026 Then MsgBox "Date non valide,esco": Exit Sub

ma non funziona

semplicemente oggi che è il 2024 ho bisogno che la data si sposti sul 2025 in automatico dal 01/01/2025 ho bisogno che l'anno rimanga sempre il 2025 perchè i preventivi sono quelli per l'estate 2025, non sempre + 1.

Ad ogni modo il tuo codice non funziona, ma va bene cosi lo metto come risolto. Elimino il mio account mi pare di capire che non sono più persona gradita sul forum ed oltretutto ogni post qualcuno c'ha i cazzi girati.

Grazie dell'aiuto

 

 

 

[Raffaele53Partecipante Raffaele53 Karma: 23 pts]

No comment, la prossima volta aiutali TU

[FROST220684Partecipante FROST220684]

Vedo che hai modificato la risposta eliminando "meglio non rispondere più a nessuno". Infatti penso che il problema sia io che chieda aiuto perchè non so fare delle cose e cerco di migliorare il mio lavoro. Ma vedo che da qualche tempo a questa parte non si risponde più o quando si risponde si cerca sempre di etichettare la persona che chiede come sfaticata, persona che gioca, persona che fa perdere tempo.

Questo è quello che non mi fa piacere, se sapevo farlo da solo sicuramente non assillavo nessuno del forum.

Ad ogni modo, ho già richiesto di essere cancellato dal forum aspetto solo che lo facciano. 

Io non sono in grado di aiutare nessuno la mia conoscenza non me lo permette. Chi invece è in grado di farlo, lo dovrebbe fare con pazienza e passione altrimenti inutile stare in forum.

Spero non ci sia un altra risposta. Con questa io ho finito. Cordialità

[Autore]

Articoli