Formula per scadenziario

Hai un problema con Excel?

Nuova discussione

Formula per scadenziario
di Xyzsm data: 30/09/2009
Salve a tutti.
non sono pratico di vba è la prima applicazione che faccio. sto realizzando una specie di scadenziario per il fitto di loculi di un cimitero. tramite la guida presente su questo sito ho realizzato il modello per inserire una nuova riga e per fare la ricerca tra le righe esistenti(una sorta di copia dell esempio della biblioteca presente su questo forum). adesso nel modello per inserire dovrei impostare una cella che mi segni quanti giorni mancano alla scadenza del fitto.
senza vba, mettendo che la data di scadenza era in a1 facevo in b1 = a1-oggi(). come posso impostare una formula simile nel modulo di inserimento? in più è possibile far cambiare colore alla cella quando mancano meno di 60 giorni alla scadenza? ciao e grazie

di Big ronnie (utente non iscritto) data: 30/09/2009
Ciao, questo è quello che cercavi.se dovassi avere ancora bisogno fai sapere.

ciao big

Sub Differenza()
Dim date As Range
Set date = Range("a1")
Range("b1") = DateDiff("d", Now, date)
If Range("b1") < 60 Then Range("b1").Interior.ColorIndex = 3
End Sub

di Xyzsm data: 30/09/2009
Ciao e grazie per la risposta.
ti incollo il codice che sto usando per inserire anche se vedrai che è una copia dell esempio della biblioteca che c'è sul sito. il mio problema è quello di inserire tramite vba una formula che ogni giorno quando apro il file mi fa la differenza tra la data di scadenza e la data odierna. quindi quando apro il file in giorni diversi il risultato sarà diverso. quando arriverà il giorno che la differenza sarà meno di 60 si colorera la cella.

Private Sub FrmInserisciInserisci_Click()
        ValScr = ActiveSheet.UsedRange.Rows.Count + 1
        If ValScr Mod 2 = 0 Then
        Range("A" & ValScr).Interior.Color = RGB(204, 204, 204)
        Range("B" & ValScr).Interior.Color = RGB(204, 204, 204)
        Range("C" & ValScr).Interior.Color = RGB(204, 204, 204)
        Range("D" & ValScr).Interior.Color = RGB(204, 204, 204)
        Range("E" & ValScr).Interior.Color = RGB(204, 204, 204)
        Range("F" & ValScr).Interior.Color = RGB(204, 204, 204)
        Range("G" & ValScr).Interior.Color = RGB(204, 204, 204)
        Range("H" & ValScr).Interior.Color = RGB(204, 204, 204)
        Range("J" & ValScr).Interior.Color = RGB(204, 204, 204)
        Range("K" & ValScr).Interior.Color = RGB(204, 204, 204)
        End If
       Range("A" & ValScr).Borders.LineStyle = xlContinuous
       Range("B" & ValScr).Borders.LineStyle = xlContinuous
       Range("C" & ValScr).Borders.LineStyle = xlContinuous
       Range("D" & ValScr).Borders.LineStyle = xlContinuous
       Range("E" & ValScr).Borders.LineStyle = xlContinuous
       Range("F" & ValScr).Borders.LineStyle = xlContinuous
       Range("G" & ValScr).Borders.LineStyle = xlContinuous
       Range("H" & ValScr).Borders.LineStyle = xlContinuous
       Range("J" & ValScr).Borders.LineStyle = xlContinuous
       Range("K" & ValScr).Borders.LineStyle = xlContinuous

        Range("A" & ValScr) = UCase(FrmInserisciCognome.Text)
        Range("B" & ValScr) = UCase(FrmInserisciNome.Text)
        Range("C" & ValScr) = UCase(FrmInserisciDataMorte.Text)
        Range("D" & ValScr) = UCase(FrmInserisciDataSepoltura.Text)
        Range("E" & ValScr) = UCase(FrmInserisciUbicazione.Text)
        Range("F" & ValScr) = UCase(FrmInserisciNumeroLoculo.Text)
        Range("G" & ValScr) = UCase(FrmInserisciLampadaVotiva.Text)
        Dim Durata As Long
        Durata = FrmInserisciDurataAffitto.Text
        Dim Sepoltura As Date
        Sepoltura = FrmInserisciDataSepoltura.Text
        Range("I" & ValScr) = DateAdd("yyyy", Durata, Sepoltura)
         Range("J" & ValScr) = Sepoltura - TODAY()
       Range("H" & ValScr) = FrmInserisciDurataAffitto.Text
        Range("L" & ValScr) = UCase(FrmInserisciConcessionario.Text)
        Range("M" & ValScr) = UCase(FrmInserisciNote.Text)
        Unload Me
End Sub

di Big ronnie (utente non iscritto) data: 30/09/2009
La data di scadenza è frminseriscidurataaffitto?

in quale colonna vuoi questa differenza?(indica la lettera)
di Big ronnie (utente non iscritto) data: 30/09/2009
Inoltre indicami il numero di riga da dove vuoi la prima differenza
di Xyzsm data: 30/09/2009
La data di sepoltura è stabilita da

range("i" & valscr) = dateadd("yyyy", durata, sepoltura)

nella colonna j dovrebbero uscire i giorni alla scadenza, se vedi avevo gia provato a scrivere qualche formula ma non vanno bene
di Xyzsm data: 30/09/2009
"inoltre indicami il numero di riga da dove vuoi la prima differenza"

se ho capito bene la richiesta dovrebbe essere la riga 3

di Big ronnie (utente non iscritto) data: 30/09/2009
Allora .... copia questa macro in un modulo standard e per avere un aggiornamento in automatico ad ogni apertura del file devi scrivere il nome(differenza) di questa macro nell'evento open in thisworkbook.
inoltre devi levare questa riga dalla tua macro

range("j" & valscr) = sepoltura - today()

provala sempre su una copia del file originale.fai sapere se và bene

ciao big

Sub Differenza()
For I = 3 To Range("I65536").End(xlUp).Row
If Not IsDate(Range("I" & I)) Then GoTo dopo
Range("j" & I) = DateDiff("d", Now, Range("I" & I))
If Range("j" & I) < 60 Then Range("j" & I).Interior.ColorIndex = 3
dopo:
Next I
End Sub

di Xyzsm data: 01/10/2009
Si sembra andare bene così, grazie mille per l'aiuto
ciao
di Xyzsm data: 02/10/2009
Rieccomi, confermo che funziona, ma devo chiudere e riaprire il file per iniziare il conteggio. se volessi aggiornare il foglio subito dopo l'inserimento per visualizzare subito il conteggio dei giorni?
di Big ronnie (utente non iscritto) data: 02/10/2009
Nella macro private sub frminserisciinserisci_click() prima di unload me inserisci queste due righe e tutto dovrebbe funzionare.
Range("j" & ValScr) = DateDiff("d", Now, Range("I" & ValScr)) If Range("j" & ValScr) < 60 Then Range("j" & valScr).Interior.ColorIndex = 3
di Xyzsm data: 05/10/2009
Ciao, scusa se riapro il post. sto cercando di abbellire un po il foglio creato e mi sono bloccato in un punto.
a partire dalla terza riga in poi volevo ordinare l intero foglio con l intere colonne secondo la colonna dei giorni rimanenti il ordine crescente

come posso fare?
di Big ronnie (utente non iscritto) data: 05/10/2009
Sempre prima di unload me

ciao big
Range("A3:M" & ValScr).Sort Key1:=Range("I3"), Order1:=xlAscending, Header:=xlGuess

di Big ronnie (utente non iscritto) data: 06/10/2009
Mi sono accorto che riordinando la righe si altera il colore grigio delle righe pari, quindi prova questa macro e vedi se tutto và bene.fai sapere

ciao big

Sub FrmInserisciInserisci_Click()
 Dim Sepoltura As Date, Durata As Long
 
        ValScr = ActiveSheet.UsedRange.Rows.Count + 1
        
        Durata = FrmInserisciDurataAffitto.Text
        Sepoltura = FrmInserisciDataSepoltura.Text
    
        Range("A" & ValScr) = UCase(FrmInserisciCognome.Text)
        Range("B" & ValScr) = UCase(FrmInserisciNome.Text)
        Range("C" & ValScr) = UCase(FrmInserisciDataMorte.Text)
        Range("D" & ValScr) = UCase(FrmInserisciDataSepoltura.Text)
        Range("E" & ValScr) = UCase(FrmInserisciUbicazione.Text)
        Range("F" & ValScr) = UCase(FrmInserisciNumeroLoculo.Text)
        Range("G" & ValScr) = UCase(FrmInserisciLampadaVotiva.Text)
        
        Range("I" & ValScr) = DateAdd("yyyy", Durata, Sepoltura)
        Range("H" & ValScr) = FrmInserisciDurataAffitto.Text
        Range("L" & ValScr) = UCase(FrmInserisciConcessionario.Text)
        Range("M" & ValScr) = UCase(FrmInserisciNote.Text)
        
        Range("j" & ValScr) = DateDiff("d", Now, Range("I" & ValScr))
        If Range("j" & ValScr) < 60 Then Range("j" & ValScr).Interior.ColorIndex = 3
        
        Range("A3:H" & ValScr).Borders.LineStyle = xlContinuous
        Range("J3:K" & ValScr).Borders.LineStyle = xlContinuous
        
        'Riordino e differenzio le righe
        Range("A3:M" & ValScr).Interior.Color = 16777215
        Range("A3:M" & ValScr).Sort Key1:=Range("I3"), Order1:=xlAscending, Header:=xlGuess
        For I = 4 To ValScr Step 2
          Range("A" & I & ":" & "M" & I).Interior.Color = RGB(204, 204, 204)
          Range("J" & I & ":" & "K" & I & ValScr).Interior.Color = RGB(204, 204, 204)
        End If
        Unload Me
End Sub

Correzzione
di Big ronnie (utente non iscritto) data: 06/10/2009
Cambia questa

range("a" & i & ":" & "m" & i).interior.color = rgb(204, 204, 204)

con

range("a" & i & ":" & "h" & i).interior.color = rgb(204, 204, 204)
di Xyzsm data: 06/10/2009
Ciao

mi dice errore di compilazione: endif senza blocco if

di Xyzsm data: 06/10/2009
Così sembra funzionare. ho modificato qualche dato nella tua macro

Sub FrmInserisciInserisci_Click()
 Dim Sepoltura As Date, Durata As Long
 
        ValScr = ActiveSheet.UsedRange.Rows.Count + 1
        
        Durata = FrmInserisciDurataAffitto.Text
        Sepoltura = FrmInserisciDataSepoltura.Text
    
        Range("A" & ValScr) = UCase(FrmInserisciCognome.Text)
        Range("B" & ValScr) = UCase(FrmInserisciNome.Text)
        Range("C" & ValScr) = UCase(FrmInserisciDataMorte.Text)
        Range("D" & ValScr) = UCase(FrmInserisciDataSepoltura.Text)
        Range("E" & ValScr) = UCase(FrmInserisciUbicazione.Text)
        Range("F" & ValScr) = UCase(FrmInserisciNumeroLoculo.Text)
        Range("G" & ValScr) = UCase(FrmInserisciLampadaVotiva.Text)
        
        Range("I" & ValScr) = DateAdd("yyyy", Durata, Sepoltura)
        Range("H" & ValScr) = FrmInserisciDurataAffitto.Text
        Range("K" & ValScr) = UCase(FrmInserisciConcessionario.Text)
        Range("L" & ValScr) = UCase(FrmInserisciNote.Text)
        
        Range("j" & ValScr) = DateDiff("d", Now, Range("I" & ValScr))
        
        If Range("j" & ValScr) < 60 Then Range("j" & ValScr).Interior.ColorIndex = 3
        
        
        'Riordino e differenzio le righe
        Range("A3:L" & ValScr).Borders.LineStyle = xlContinuous
        Range("A3:L" & ValScr).Interior.Color = 16777215
        Range("A3:L" & ValScr).Sort Key1:=Range("J3"), Order1:=xlAscending, Header:=xlGuess
        For i = 4 To ValScr Step 2
         Range("A" & i & ":" & "L" & i).Interior.Color = RGB(204, 204, 204)
        Next
        Unload Me
End Sub

di Xyzsm data: 06/10/2009
Così sembra funzionare. ho modificato qualche dato nella tua macro

Sub FrmInserisciInserisci_Click()
 Dim Sepoltura As Date, Durata As Long
 
        ValScr = ActiveSheet.UsedRange.Rows.Count + 1
        
        Durata = FrmInserisciDurataAffitto.Text
        Sepoltura = FrmInserisciDataSepoltura.Text
    
        Range("A" & ValScr) = UCase(FrmInserisciCognome.Text)
        Range("B" & ValScr) = UCase(FrmInserisciNome.Text)
        Range("C" & ValScr) = UCase(FrmInserisciDataMorte.Text)
        Range("D" & ValScr) = UCase(FrmInserisciDataSepoltura.Text)
        Range("E" & ValScr) = UCase(FrmInserisciUbicazione.Text)
        Range("F" & ValScr) = UCase(FrmInserisciNumeroLoculo.Text)
        Range("G" & ValScr) = UCase(FrmInserisciLampadaVotiva.Text)
        
        Range("I" & ValScr) = DateAdd("yyyy", Durata, Sepoltura)
        Range("H" & ValScr) = FrmInserisciDurataAffitto.Text
        Range("K" & ValScr) = UCase(FrmInserisciConcessionario.Text)
        Range("L" & ValScr) = UCase(FrmInserisciNote.Text)
        
        Range("j" & ValScr) = DateDiff("d", Now, Range("I" & ValScr))
        
        If Range("j" & ValScr) < 60 Then Range("j" & ValScr).Interior.ColorIndex = 3
        
        
        'Riordino e differenzio le righe
        Range("A3:L" & ValScr).Borders.LineStyle = xlContinuous
        Range("A3:L" & ValScr).Interior.Color = 16777215
        Range("A3:L" & ValScr).Sort Key1:=Range("J3"), Order1:=xlAscending, Header:=xlGuess
        For i = 4 To ValScr Step 2
         Range("A" & i & ":" & "L" & i).Interior.Color = RGB(204, 204, 204)
        Next
        Unload Me
End Sub

di Xyzsm (utente non iscritto) data: 06/10/2009
Mi sono accorto di un altro problema. siccome sul foglio1 del mio lavoro to portanto il conto dei loculi disponibili per le diverse cappelle ho scritto una cosa così (riporto l esempio solo per la cappella superiore). sembrava andare bene, ma se cancello una riga (con tasto destro sulla riga - cancella) ho notato che lo script continua a conteggiare anche le righe eliminate. devo tenere in considerazione qualcosa riguardo all eliminazione delle righe?

Private Sub Worksheet_Activate()
totaleSuperiore = Worksheets("Cappella Superiore").UsedRange.Rows.Count
differenzasuperiore = Worksheets("Foglio1").Cells(11, 6) - totaleSuperiore + 2
Worksheets("Foglio1").Cells(11, 7).Value = differenzasuperiore
End Sub

di Big ronnie (utente non iscritto) data: 06/10/2009
Cancellare non elimina la riga quindi il valore di totalesuperiore rimane invariato. devi eliminare la riga cos' qundo riattivi il foglio il valore si aggiorna.

ciao big

di Xyzsm (utente non iscritto) data: 07/10/2009
Ciao, credo di aver risolto così. ho creato un tasto sul foglio ed ho applicato il codice riportato sotto. ho adattato anche qui il codice per alternare il colore delle righe(siccome le prime due righe del foglio contengono intestazioni varie, i record partono dalla riga 3 in poi)

volevo chiederti se credi che possa andare bene così o ci saranno bug che al momento non ho notato

grazie per l'infinita disponibilità, dopo questo progetto credo che inizierò a studiare per bene il tutto

Sub eliminarecord()
        Numriga = ActiveCell.Row
        Rows(Numriga & ":" & Numriga).Select

        Selection.Delete Shift:=xlUp

        ValScr = ActiveSheet.UsedRange.Rows.Count
        If ValScr > 2 Then
        Range("A3:L" & ValScr).Borders.LineStyle = xlContinuous
        Range("A3:L" & ValScr).Interior.Color = 16777215
        Range("A3:L" & ValScr).Sort Key1:=Range("J3"), Order1:=xlAscending, Header:=xlGuess
        For i = 4 To ValScr Step 2
         Range("A" & i & ":" & "L" & i).Interior.Color = RGB(204, 204, 204)
        Next
        End If
End Sub

di Big ronnie (utente non iscritto) data: 07/10/2009
Sembra tutto a posto.le prime tre righe possono essere sostituite da questa:

rows(activecell.row).delete

ciao big
di Xyzsm data: 16/10/2009
Ho notato un problema, nel campo dove c'è la data di morte a volte mi inverte i giorni con i mesi, se scrivo 12/06/2009 lui lo cambia in 06/12/2009 ma non succede sempre. ho controllato il formato della cella ed è settata su date. da cosa può dipendere?

Vuoi Approfondire?