Excel Modifica Macro Trova e Colora

[Statix]

Ciao Anthony
avrei bisogno di fare una modifica a questa formula.

Codice: Seleziona tutto

Sub Statix()
I = 2
For Each Ambo In Range("R3:AA3")
Range(Ambo.address).Interior.Colorindex = I
I = I + 1
Next Ambo
I=2
On Error Resume next
For Each Ambo in Range("R3:AA3")
Range("E4").select     'INVECE DI Range("E5").select
Cells.find(What:=Ambo, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, _
   SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
If activecell.address <>"$E$4" Then ActiveCell.interior.Colorindex=I
I=I+1
Next Ambo
End Sub

Ho 10 range di 10 celle ciascuna.

in questo Range("B6:K200") devo trovare i 10 ambi Range("B3:K3")
in questo Range("L6:U200") devo trovare i 10 ambi Range("L3:U3")
in questo Range("V6:AE200") devo trovare i 10 ambi Range("V3:AE3")
in questo Range("AF6:AO200") devo trovare i 10 ambi Range("AF3:AO3")
in questo Range("AP6:AY200") devo trovare i 10 ambi Range("AP3:AY3")
in questo Range("AZ6:BI200") devo trovare i 10 ambi Range("AZ3:BI3")
in questo Range("BJ6:BS200") devo trovare i 10 ambi Range("BJ3:BS3")
in questo Range("BT6:CC200") devo trovare i 10 ambi Range("BT3:CC3")
in questo Range("CD6:CM200") devo trovare i 10 ambi Range("CD3:CM3")
in questo Range("CN6:CW200") devo trovare i 10 ambi Range("CN3:CW3")

Ho provato a modificare qualcosa,con

Codice: Seleziona tutto

Sub Statix()
I = 3
For Each Ambo In Range("B3:K3")
Range(Ambo.Address).Interior.ColorIndex = I
I = I
Next Ambo
I = 3
On Error Resume Next
For Each Ambo In Range("B3:K3")
Range("B6:K97").Select     'INVECE DI Range("E5").select
Selection.Find(What:=Ambo, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, _
   SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
If ActiveCell.Address <> "$B$6" Then ActiveCell.Interior.ColorIndex = I
I = 3
Next Ambo
Call Statix2
End Sub

Le macro funzionano ma non perfettamente,la prima cella
di ogni range,se l'ambo è presente non me lo rileva.
inoltre per ogni Range("B3:K3") se l'ambo non è presente
si deve colorare di rosso,mentre quelli presenti in bianco
il Range("B4:K4") si dovrebbe colorare di verde ogni cella che viene controllata.

[pietrol]

Ciao statix
non entro nello funzionamento della macro però

Range("B6:K97").Select '<<<<<<La prima cella del range è B6
Selection.Find(What:=Ambo, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
If ActiveCell.Address <> "$B$6" Then ActiveCell.Interior.ColorIndex = I '<<<<<<<Qui gli dici di non colorare se la cella è B6, quindi...è normale che non te la colori

ciao
pietrol

[pietrol]

Scusa ho usato il Quote invece del Code, rifaccio

Codice: Seleziona tutto

Range("B6:K97").Select                                        '<<<<<<La prima cella del range è B6
.
.
If ActiveCell.Address <> "$B$6" Then ActiveCell.Interior.ColorIndex = I               '<<<<<<<Qui gli dici di non colorare se la cella è B6, quindi...è normale che non te la colori


pietrol

[Statix]

Ciao Anthony
bentornato,
il problema non lo ho ancora risolto.

[Anthony47]

Guarda che se facevi lavorare un po' piu' pietrol io non mi sarei offeso
Ho modificato la macro in questo modo:

Codice: Seleziona tutto

Sub Bari()
I = 4
On Error Resume Next
For Each Ambo In Range("B3:K3")
 Ambo.Offset(1, 0).Interior.ColorIndex = 4
 Ambo.Interior.ColorIndex = 3
 Range("B5:K99").Select
Selection.Find(What:=Ambo, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, _
   SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
AAA = ActiveCell.Address
If ActiveCell.Address <> "$B$5" Then
 ActiveCell.Interior.ColorIndex = I
 Ambo.Interior.ColorIndex = 2
End If
I = I + 1
Next Ambo
Call Cagliari

End Sub


Come da tua richiesta, la riga 3 (es B3:K3) rimane colorata di rosso se non c' e' quell' ambo o bianco se c' e'; se vuoi colorare con lo stesso colore dell' ambo trovato, modifica quel "Ambo.Interior.ColorIndex = 2" in

Codice: Seleziona tutto

Ambo.Interior.ColorIndex = I


Ciao.