Cerca parola ed inserimento stringa in altra posizione

[enrico43]

Buongiorno,
allego un file e cerco aiuto, visto che non riesco a nidificare i “Case” in una macro. Ma andrebbe bene anche avere 2 macro. Sostanzialmente devo cercare una parola (sempre e solo in lettere maiuscole) nella colonna S, spostarmi a sinistra stessa riga nella colonna R, trovare il valore che sta immediatamente sotto (sempre negativo però con numero di righe variabile) e sulla stessa riga di questo valore trovato, nella colonna T scrivere “1a” se la parola trovata è “NON ESEGUITA” o “2a” se la parola trovata è “DIFFORMITA’” e colorare queste celle in rosso.
Poi la macro per fare la somma dei valori che nella colonna R sono sulla stessa riga dei 1a e 1b l’ho fatta (piuttosto contorta, non ricordo bene il Case) ed i risultati sono nelle celle a fine colonna R.
Mancano i casi 2a e 2b che i colleghi stanno sistemando (cioè definire la parola per intercettarli nella colonna S) e poi integrerò la macro con relativa ricerca.
Non occorre che facciate le ore piccole, come ho visto fare molte volte un po’ a tutti, ultima di Anthony ier sera, anzi stamattina.
Un cordiale saluto
Enrico
http://www.filedropper.com/1a-1b-2a-2b
Excel 2003
XP Sp3

[enrico43]

Salve,
con questa macro inserita in un nuovo modulo

Option Compare Text
Sub IndividuaSposta()
Dim CL As Object
Set Zona = Worksheets(1).Range("S:S")
Dimmi = InputBox("Scrivi la parola da cercare")
If Dimmi = "" Then Exit Sub
For Each CL In Zona
If CL.Value Like "*" & Dimmi & "*" Then
CL.Select
Selection.Interior.ColorIndex = 6
ActiveCell.Offset(0, -1).Select
Selection.End(xlDown).Select ' End(xlDown).Offset(0, 2).Select
ActiveCell.Offset(0, 2) = "1a" '.Select
'ActiveCell.FormulaR1C1 = "1a"
End If
Next
10:
MsgBox "Ricerca Terminata"
End Sub

avrei risolto. Maaaaa....non mi scrive "1a" nella colonna +2 a destra. Trova le ricorrenze (ho messo il giallo solo per vedere se le intercetta), ho fatto molti tentativi (si vede), niente.
Dov'è che sbaglio?
Un grazie insieme ad un
Cordiale Saluto
Enrico

[enrico43]

Risolto. Trova la parola, si sposta di 1 colonna a sinistra stessa riga, scende finchè non trova un valore e sulla stessa riga 2 colonne adestra scrive "1a". E questo per ogni parola trovata.
Option Compare Text
Sub IndividuaSposta()
Dim CL As Object
Set Zona = Worksheets(1).Range("S:S")
Dimmi = InputBox("Scrivi la parola da cercare")
If Dimmi = "" Then Exit Sub
For Each CL In Zona
If CL.Value Like "*" & Dimmi & "*" Then
CL.Select
Selection.Interior.ColorIndex = 6
ActiveCell.Offset(0, -1).Select
Dim iRow, icol As Integer
iRow = ActiveCell.Row
icol = 18
While Cells(iRow, icol).Value = 0
iRow = iRow + 1
Wend
ActiveCell.Offset(0, 2) = "1a" '.Select
'ActiveCell.FormulaR1C1 = "1a"
End If
Next
10:
MsgBox "Ricerca Terminata"
End Sub
Saluti
Enrico