Come scrivo in VBA: per ogni cella contenente “INTERVENTO” cambiagli colore?

Question

Ho una tabella di sette  colonne a righe crescenti che mi viene fornita già compilata. Nella prima colonna (A) riporto le date e  nella colonna E  riporto la descrizione.

Ogni operazione inizia con la descrizione “INTERVENTO” in colonna E e termina dopo un numero variabile di righe con l’ultima con la descrizione in colonna E “INTERVENTO”.

La colonna C è riservata alle entrate, la D alle uscite, la F al risultato economico.

Quando inizio un intervento ho un’uscita di cassa indicata in colonna D, quando lo termino ho un’entrata  indicata in colonna C. Le cifre son tutte positive.

La macro dovrebbe identificare l’inizio di INTERVENTO e colorarlo di rosso ( in questo caso risulta superiore a zero la cella in colonna D e vuota quella in colonna C)

 e la fine di INTERVENTO e colorarlo di verde( in questo caso risulta superiore a zero la cella in colonna C  e vuota quella in colonna D). Vorrei anche riportare il risultato economico nella colonna F nella cella sulla riga di inizio intervento ( somma di colonna C – somma di colonna D di tutti gli importi compresi fra inizio e fine intervento ).

Per ora son qua fermo alla prima domanda non sapendo come definire l’oggetto per usare for each…next.

Ho ben in vista il pollice che indica una direzione  qualsiasi, spero che qualcuno si fermi e mi dia un passaggio perchè se devo farla a piedi non arrivo più.

Answer 1

Ciao barbiturico,

allora se non ci sono altre sorprese una soluzione potrebbe essere questa:

Option Explicit

Private Const mcMod = "Modulo2"

Private Const COL_DATA = 0

Private Const COL_ENTR = 1

Private Const COL_USCI = 2

Private Const COL_RIEC = 3

Private Const COL_DESC = 4

Private Const COL_DATA_NAME = "Data"

Private Const VAL_BEGEND = "Intervento"

Public Sub Test2()

Const cProc = "Test2"

    If StrComp(Application.ActiveCell.Value _

             , COL_DATA_NAME _

             , vbTextCompare) Then

      MsgBox "Questa macro deve essere avviata dalla cella " _

           & "'" & COL_DATA_NAME & "'." _

           , vbOKOnly + vbExclamation _

           , cProc

      Exit Sub

    Else

      Test2Execute Application.ActiveCell

    End If

End Sub

Private Sub Test2Execute(ByVal rng As Excel.Range)

Const cProc = "Test2Execute"

On Error GoTo ErrH

Dim wsh     As Excel.Worksheet

Dim rngData As Excel.Range

Dim rngEntr As Excel.Range

Dim rngUsci As Excel.Range

Dim rngRiEc As Excel.Range

Dim rngDesc As Excel.Range

Dim r       As Long     ' Row

Dim dtmDate As Date

Dim dblTot  As Double

Dim blnEnd  As Boolean

Dim blnTot  As Boolean

    Set wsh = rng.Parent

    Do

      r = r + 1

      With rng

        If IsEmpty(.Offset(r, COL_DATA).Value) Then

          rngRiEc.Value = dblTot

          Exit Do

        End If

        Set rngData = .Offset(r, COL_DATA)

        Set rngEntr = .Offset(r, COL_ENTR)

        Set rngUsci = .Offset(r, COL_USCI)

        Set rngDesc = .Offset(r, COL_DESC)

        If rngDesc.Value = VAL_BEGEND And rngEntr.Value <> "" Then

          rngDesc.Font.Color = vbGreen

          blnEnd = True

          dtmDate = rngData.Value

          Set rngRiEc = .Offset(r, COL_RIEC)

        ElseIf rngDesc.Value = VAL_BEGEND Then

          rngDesc.Font.Color = vbRed

          If blnEnd Then blnTot = True

        Else

          If blnEnd And rngData.Value <> dtmDate Then blnTot = True

        End If

        If blnTot Then

          rngRiEc.Value = dblTot

          Set rngRiEc = Nothing

          If rngEntr.Value <> "" _

             Then dblTot = rngEntr.Value _

             Else dblTot = -rngUsci.Value

          blnEnd = False

          blnTot = False

        Else

          If rngEntr.Value <> "" _

             Then dblTot = dblTot + rngEntr.Value _

             Else dblTot = dblTot - rngUsci.Value

        End If

      End With

    Loop

ExitProc:

    Set rngDesc = Nothing

    Set rngRiEc = Nothing

    Set rngUsci = Nothing

    Set rngEntr = Nothing

    Set rngData = Nothing

    Set wsh = Nothing

    Exit Sub

ErrH:

    MsgBox "ERR#" & Err.Number & vbNewLine & Err.Description _

         , vbCritical + vbOKOnly _

         , mcMod & "." & cProc

    Resume ExitProc

End Sub

Answer 2

Ciao barbiturico,

ancora non ci siamo! Nel tuo esempio hai evidenziato in giallo e verde, alternati, dei blocchi. Suppongo per distinguere una operazione dalla successiva. Se è così allora perché l'operazione che hai colorato in verde, compresa fra le date 26/07 e  02/08, contiene alla riga 14 un "Intervento" che è "Finale" in base alla regola che ci hai esposto nel post del 26/12 dove dicevi che è "Finale" un "Intervento" con Entrate>0? Tanto più che le restanti operazioni sono invece coerenti con le regole che fin qui ci hai esposto. Facci sapere, perché se è solo una svista allora tutto è chiaro e si potrebbe anche procedere con la versione finale.

Cioè, no. Sarebbe da chiarire anche dove mettere le somme. Perché in un primo tempo parlavi di metterle in corrispondenza dell'"Intervento" iniziale, ma poi abbiamo scoperto che di iniziali ce ne sono più di uno. Come la mettiamo? Io proporrei di metterle in corrispondenza dell'"Intervento" finale, ché almeno ce n'è solo uno per operazione. Che dici?

Buon anno! :)

Answer 3

Ecco l'esempio che mi hai richiesto,

https://skydrive.live.com/?cid=bf5f1db009ed5a40&id=BF5F1DB009ED5A40!103#cid=BF5F1DB009ED5A40&id=BF5F1DB009ED5A40!103

e se ti  stai mettendo in ghingheri per il capodanno: Buon anno!!

Ma niente petardi ai politici in parti delicate.

Answer 4

Seguendo la tua procedura

"Intervento" finale ha sempre rng(r, COL_DESC).Value="Intervento"  

rng(r, COL_ENTR).Value>0

 e rng(r, COL_USCI).Value=""

"Intervento" iniziale ha sempre rng(r, COL_DESC).Value="Intervento"

rng(r, COL_ENTR).Value=""

e rng(r, COL_USCI).Value>0

Stavo cercando di aggiungere alla tua macro  altri ELSE IF per testare queste condizioni.

Spero di non aver scritto fesserie.

Intanto preparo un file da pubblicare.

Grazie mille

Answer 5

Ciao barbiturico,

dunque un "INTERVENTO" finale precedente lo si riconosce dal fatto che ha data diversa? Uhm… sempre più misteriosa questa cosa. Che ne dici di confezionare un esempio significativo e caricarlo in qualche sito di condivisione, per esempio http://skydrive.live.com?