Torna indietro   Hardware Upgrade Forum > Software > Programmazione

Renault Twingo E-Tech Electric: che prezzo!
Renault Twingo E-Tech Electric: che prezzo!
Renault annuncia la nuova vettura compatta del segmento A, che strizza l'occhio alla tradizione del modello abbinandovi una motorizzazione completamente elettrica e caratteristiche ideali per i tragitti urbani. Renault Twingo E-Tech Electric punta su abitabilità, per una lunghezza di meno di 3,8 metri, abbinata a un prezzo di lancio senza incentivi di 20.000€
Il cuore digitale di F1 a Biggin Hill: l'infrastruttura Lenovo dietro la produzione media
Il cuore digitale di F1 a Biggin Hill: l'infrastruttura Lenovo dietro la produzione media
Nel Formula 1 Technology and Media Centre di Biggin Hill, la velocità delle monoposto si trasforma in dati, immagini e decisioni in tempo reale grazie all’infrastruttura Lenovo che gestisce centinaia di terabyte ogni weekend di gara e collega 820 milioni di spettatori nel mondo
DJI Osmo Mobile 8: lo stabilizzatore per smartphone con tracking multiplo e asta telescopica
DJI Osmo Mobile 8: lo stabilizzatore per smartphone con tracking multiplo e asta telescopica
Il nuovo gimbal mobile DJI evolve il concetto di tracciamento automatico con tre modalità diverse, un modulo multifunzionale con illuminazione integrata e controlli gestuali avanzati. Nel gimbal è anche presente un'asta telescopica da 215 mm con treppiede integrato, per un prodotto completo per content creator di ogni livello
Tutti gli articoli Tutte le news

Vai al Forum
Rispondi
 
Strumenti
Old 07-09-2009, 11:56   #1
radeon_snorky
Senior Member
 
Iscritto dal: Mar 2003
Messaggi: 2151
[VBA][EXCEL]differenza di date su colonna, modifica colore righe, msgbox di riepilogo

piccolo questito velocissimo:
Codice:
Sub scadenze()
Dim settimana As Long
Dim mese As Long
Dim trimestre As Long
Dim differenza As Long
Dim scadenza As Date
Dim adesso As Date
settimana = 7
mese = 30
trimestre = 90
adesso = Now()
scadenza = Cells.Range("O127")
differenza = DateDiff("d", adesso, scadenza)
If differenza < trimestre and differenza > mese Then
' riga colore AZZURRO
End If
If differenza < mese And differenza > settimana Then
' riga colore ARANCIONE
End If
If differenza < settimana Then
' riga colore ROSSO
End If
msgbox "pratiche urgenti: 1 2 3 ; pratiche in scadenza: 4 5 6 ; prossime pratiche: 7 8 9 "
End Sub
avrei bisogno che questo codice venisse eseguito su un range e si ripetesse per tutte le celle della colonna "O" che risultano piene e al posto del commento vorrei il codice per impostare il colore alla row corrispondente
e solo alla fine mostrare una msgbox con il riepilogo di tutte le righe modificate (quindi un msgbox che all'occorrenza possa contenere anche decine di righe) mi serve capire come memorizzare il riferimento riga, poi vedo di cavarmela con la realizzazione del messaggio...

grazie!
radeon_snorky è offline   Rispondi citando il messaggio o parte di esso
Old 07-09-2009, 16:48   #2
radeon_snorky
Senior Member
 
Iscritto dal: Mar 2003
Messaggi: 2151
Codice:
Dim settimana As Long
Dim mese As Long
Dim trimestre As Long
Dim differenza As Long
Dim scadenza As Date
Dim adesso As Date
Dim index As Long
Dim lastrif As Long
settimana = 7
mese = 30
trimestre = 90
adesso = Now()
lastrif = Sheets("pratiche").Range("O" & Rows.Count).End(xlUp).Row
For i = 3 To lastrif
index = i
If Sheets("pratiche").Range("O" & index).Value = "" Then
Rows(index).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = 2
        .TintAndShade = 0
        .PatternTintAndShade = 0
        End With
GoTo 10
End If
scadenza = Sheets("pratiche").Range("O" & index).Value
scadenza = CDate(Replace(scadenza, " ", "/"))
differenza = DateDiff("d", adesso, scadenza)
If differenza > mese Then
 Rows(index).Select
    With Selection.Interior
.ColorIndex = 2
    End With
GoTo 10
End If
If differenza < mese And differenza > settimana Then
     Rows(index).Select
    With Selection.Interior
        .ColorIndex = 45
    End With
End If
If differenza < settimana Then
    Rows(index).Select
    With Selection.Interior
        .ColorIndex = 3
    End With
End If
10:
Next i
mi ci sono messo d'impegno ed ecco il risultato! (scarsino, eh!)
consigli su come migliorarlo?

EDIT:
sistemato un errorino...
e aggiungo una domanda: se metto il codice all'avvio fa proprio quello che mi aspetto... se però lo metto in un pulsante, no! mi spiego: se cancello una data e avvio la macro... non mi vede il cambiamento e la riga rimane colorata! se chiudo il file e lo riapro ecco che la stessa macro posizionata in apertura file mi aggiorna correttamente i colori, perché?

Ultima modifica di radeon_snorky : 07-09-2009 alle 18:11.
radeon_snorky è offline   Rispondi citando il messaggio o parte di esso
Old 11-09-2009, 11:54   #3
radeon_snorky
Senior Member
 
Iscritto dal: Mar 2003
Messaggi: 2151
se fosse utile a qualcuno:
Codice:
Sub scadenze()
Dim settimana As Long
Dim mese As Long
Dim differenza As Long
Dim scadenza As Date
Dim adesso As Date
Dim index As Long
Dim lastrif As Long
settimana = 7
mese = 30
adesso = Now()
lastrif = Sheets("pratiche").Range("A" & Rows.Count).End(xlUp).Row 
For i = 3 To lastrif
index = i
If Sheets("pratiche").Range("O" & index).Value = "" Then
Rows(index).Select
    With Selection.Interior
        .ColorIndex = 34
        End With
        With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
GoTo 10
End If
scadenza = Sheets("pratiche").Range("O" & index).Value
scadenza = CDate(Replace(scadenza, " ", "/"))
differenza = DateDiff("d", adesso, scadenza)
If differenza > mese Then
Rows(index).Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
End If
If differenza < mese And differenza > settimana Then
     Rows(index).Select
    With Selection.Interior
        .ColorIndex = 45
    End With
        With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With

End If
If differenza <= settimana Then
    Rows(index).Select
    With Selection.Interior
        .ColorIndex = 3
    End With
        With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    MsgBox ("la pratica " & Sheets("pratiche").Range("A" & index).Value & " risulta in scadenza")
    End If
10:
Next i
Sheets("pratiche").Range("J1").Value = Now()
Worksheets("pratiche").Range("A1").Select
End Sub
un commento veloce per spiegare cosa fa il codice:
inizialmente assegno dei valori alle variabili settimana mese e adesso (solo per mia personale comodità... si possono evitare usando i valori numerici!)
poi cerco l'ultima riga compilata nel foglio (cerco l'ultima pratica inserita)
così posso ciclare un numero di volte pari alle righe scritte (3 to lastrif, dove 3 è la posizione della prima pratica e lastrif l'ultima)
poi inizio a verificare se la cella della colonna O di quella riga (O & index, che varia ad ogni ciclo) è vuota ( "" ) se così è, dopo aver colorato la riga, salto a piè pari (goto 10) alla fine del ciclo (10: ) e aumento di uno (next i)
nel caso la cella O & index fosse piena calcolo la differenza tra il contenuto (scadenza) e now() (che ho chiamato "adesso") e la esprimo in giorni "d" poi verifico che la differenza sia maggiore, compresa o inferiore a certi valori e a seconda del caso modifico la riga con colori diversi e, in ultimo, avviso con un msgbox quelle che sono in "scadenza".
le ultime due righe mi servono per altre questioni e possono essere tolte, comunque lo scpiego:
su j1 vado a scrivere now() per poter verificare (da un'altra macro) se il controllo è già avvenuto oppure è necessario fare un "refresh" delle scadenze, magari perché si vuole mettere la verifica all'apertura del file ma non si vuole che succeda sempre ma solo alla prima apertura giornaliera o magari alla prima apertura dopo x ore; il select su A1 mi serve solamente per spostarmi su A1 visto che il ciclo si ferma evidenziando l'ultima riga, è solo un vezzo...

NB se avete consigli su come migliorare il codice fate pure!!! io son sempre qua!!!

ps sto ancora cercando un modo per creare un msgbox che contenga tutti gli avvisi (quindi in numero variabile) raggruppati in un solo messaggio!!!! HELP
radeon_snorky è offline   Rispondi citando il messaggio o parte di esso
 Rispondi


Renault Twingo E-Tech Electric: che prezzo! Renault Twingo E-Tech Electric: che prezzo!
Il cuore digitale di F1 a Biggin Hill: l'infrastruttura Lenovo dietro la produzione media Il cuore digitale di F1 a Biggin Hill: l'infrast...
DJI Osmo Mobile 8: lo stabilizzatore per smartphone con tracking multiplo e asta telescopica DJI Osmo Mobile 8: lo stabilizzatore per smartph...
Recensione Pura 80 Pro: HUAWEI torna a stupire con foto spettacolari e ricarica superveloce Recensione Pura 80 Pro: HUAWEI torna a stupire c...
Opera Neon: il browser AI agentico di nuova generazione Opera Neon: il browser AI agentico di nuova gene...
Snap e Perplexity unite: dal prossimo an...
La Cina dice addio a NVIDIA? Il governo ...
Microlino, simbolo italiano della mobili...
Apple disattiverà la sincronizzaz...
Google lancia l'allarme: attenzione ai m...
Primo test drive con Leapmotor B10: le c...
'Non può essere un robot': l'uman...
Monopattino elettrico Segway Ninebot Max...
Syberia Remastered è disponibile:...
Sony scopre che tutti i modelli AI hanno...
Amazon nasconde un -15% su 'Seconda Mano...
Due occasioni Apple su Amazon: iPhone 16...
Verso la fine della TV tradizionale? I g...
Cassa JBL a 39€, portatili, smartphone, ...
Cometa interstellare 3I/ATLAS: la sonda ...
Chromium
GPU-Z
OCCT
LibreOffice Portable
Opera One Portable
Opera One 106
CCleaner Portable
CCleaner Standard
Cpu-Z
Driver NVIDIA GeForce 546.65 WHQL
SmartFTP
Trillian
Google Chrome Portable
Google Chrome 120
VirtualBox
Tutti gli articoli Tutte le news Tutti i download

Strumenti

Regole
Non Puoi aprire nuove discussioni
Non Puoi rispondere ai messaggi
Non Puoi allegare file
Non Puoi modificare i tuoi messaggi

Il codice vB è On
Le Faccine sono On
Il codice [IMG] è On
Il codice HTML è Off
Vai al Forum


Tutti gli orari sono GMT +1. Ora sono le: 02:31.


Powered by vBulletin® Version 3.6.4
Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Served by www3v