Selezionare per colore carattere

[gimart]

Ciao a tutti. In Excel 2003 ho dei fogli in cui, in molte celle, ho dei
numeri in carattere rosso. Ho bisogno di selezionare in contemporanea tutte
quelle celle. Sono riuscito a fare l'operazione con "Modifica" -> "Trova" e
quindi selezionando "Cerca in: valore" e "Formato" -> "Carattere" -> "Colore"
-> "Rosso".
A questo punto, nella parte inferiore della finestra "Trova e sostituisci"
mi compare l'elenco di tutte le celle che mi interessano. Allora le seleziono
tutte, chiudo la finestra e le celle mi rimangono selezionate. Mi sono detto:
perchè non fare una macro? E ci ho provato con "Macro" -> "Registra macro".
Senonchè la macro si interrompe dopo aver selezionato il range del foglio in
cui deve operare la selezione, credo per l'incapacità di effettuare la
selezione delle celle interessate.
Come posso fare? Grazie.

[Mauro Gamberini]

Post by gimart
Ciao a tutti. In Excel 2003 ho dei fogli in cui, in molte celle, ho dei
numeri in carattere rosso. Ho bisogno di selezionare in contemporanea tutte
quelle celle. Sono riuscito a fare l'operazione con "Modifica" -> "Trova" e
quindi selezionando "Cerca in: valore" e "Formato" -> "Carattere" -> "Colore"
-> "Rosso".
A questo punto, nella parte inferiore della finestra "Trova e sostituisci"
mi compare l'elenco di tutte le celle che mi interessano. Allora le seleziono
perchè non fare una macro? E ci ho provato con "Macro" -> "Registra macro".
Senonchè la macro si interrompe dopo aver selezionato il range del foglio in
cui deve operare la selezione, credo per l'incapacità di effettuare la
selezione delle celle interessate.
Come posso fare?

Se ti va bene selezionare prima le celle:

Public Sub mSelezionaRosse()

Dim c As Range
Dim rng As Range

With Selection
For Each c In Selection
If c.Font.Color = RGB(255, 0, 0) Then
If rng Is Nothing Then
Set rng = Range(c.Address)
Else
Set rng = Union(rng, c)
End If
End If
Next
End With

rng.Select

Set c = Nothing
Set rng = Nothing

End Sub

Questo invece su tutte le celle con dati del foglio:

Public Sub mSelezionaRosse()

Dim c As Range
Dim rng As Range

With ActiveSheet

For Each c In .UsedRange
If c.Font.Color = RGB(255, 0, 0) _
And Len(c.Value) > 0 Then
If rng Is Nothing Then
Set rng = Range(c.Address)
Else
Set rng = Union(rng, c)
End If
End If
Next
End With

rng.Select

Set c = Nothing
Set rng = Nothing

End Sub

Nessuna delle due funziona se il colore
dipende da formattazione condizionale.
La discriminante va fatta, in questo caso,
sulla discriminante delle formattazione
condizionale.

[gimart]

Alla grande Mauro, come al solito del resto :-).
La prima mi va benissimo. Solo un'altra domandina. Poichè il range dei vari
fogli cui applico questa macro è sempre lo stesso (si tratta di fogli spese
mensili), è possibile modificarla in modo che non si debba selezionare prima
le celle?

Post by Mauro Gamberini

Post by gimart
Ciao a tutti. In Excel 2003 ho dei fogli in cui, in molte celle, ho dei
numeri in carattere rosso. Ho bisogno di selezionare in contemporanea tutte
quelle celle. Sono riuscito a fare l'operazione con "Modifica" -> "Trova" e
quindi selezionando "Cerca in: valore" e "Formato" -> "Carattere" -> "Colore"
-> "Rosso".
A questo punto, nella parte inferiore della finestra "Trova e sostituisci"
mi compare l'elenco di tutte le celle che mi interessano. Allora le seleziono
perchè non fare una macro? E ci ho provato con "Macro" -> "Registra macro".
Senonchè la macro si interrompe dopo aver selezionato il range del foglio in
cui deve operare la selezione, credo per l'incapacità di effettuare la
selezione delle celle interessate.
Come posso fare?

Public Sub mSelezionaRosse()
Dim c As Range
Dim rng As Range
With Selection
For Each c In Selection
If c.Font.Color = RGB(255, 0, 0) Then
If rng Is Nothing Then
Set rng = Range(c.Address)
Else
Set rng = Union(rng, c)
End If
End If
Next
End With
rng.Select
Set c = Nothing
Set rng = Nothing
End Sub
Public Sub mSelezionaRosse()
Dim c As Range
Dim rng As Range
With ActiveSheet
For Each c In .UsedRange
If c.Font.Color = RGB(255, 0, 0) _
And Len(c.Value) > 0 Then
If rng Is Nothing Then
Set rng = Range(c.Address)
Else
Set rng = Union(rng, c)
End If
End If
Next
End With
rng.Select
Set c = Nothing
Set rng = Nothing
End Sub
Nessuna delle due funziona se il colore
dipende da formattazione condizionale.
La discriminante va fatta, in questo caso,
sulla discriminante delle formattazione
condizionale.
--
---------------------------
Mauro Gamberini
http://www.riolab.org/
http://blog.maurogsc.eu/

[Mauro Gamberini]

Post by gimart
La prima mi va benissimo. Solo un'altra domandina. Poichè il range dei vari
fogli cui applico questa macro è sempre lo stesso (si tratta di fogli spese
mensili), è possibile modificarla in modo che non si debba selezionare prima
le celle?

Certo che si può!

Public Sub mSelezionaRosse()

Dim c As Range
Dim rngFoglio As Range
Dim rng As Range

Set rngFoglio = Range("A1:D10")

For Each c In rngFoglio
If c.Font.Color = RGB(255, 0, 0) Then
If rng Is Nothing Then
Set rng = Range(c.Address)
Else
Set rng = Union(rng, c)
End If
End If
Next

rng.Select

Set c = Nothing
Set rng = Nothing
Set rngFoglio = Nothing

End Sub


Modifica A1:D10 con il tuo Range.

[gimart]

Perfetto, funziona benissimo. Ma .....l'appetito vien mangiando: è possibile
sommare i valori delle celle selezionate e inserire il risultato in
un'apposita cella?
Non mi mandare a quel paese :-)) .......

Post by Mauro Gamberini

Post by gimart
La prima mi va benissimo. Solo un'altra domandina. Poichè il range dei vari
fogli cui applico questa macro è sempre lo stesso (si tratta di fogli spese
mensili), è possibile modificarla in modo che non si debba selezionare prima
le celle?

Certo che si può!
Public Sub mSelezionaRosse()
Dim c As Range
Dim rngFoglio As Range
Dim rng As Range
Set rngFoglio = Range("A1:D10")
For Each c In rngFoglio
If c.Font.Color = RGB(255, 0, 0) Then
If rng Is Nothing Then
Set rng = Range(c.Address)
Else
Set rng = Union(rng, c)
End If
End If
Next
rng.Select
Set c = Nothing
Set rng = Nothing
Set rngFoglio = Nothing
End Sub
Modifica A1:D10 con il tuo Range.
--
---------------------------
Mauro Gamberini
http://www.riolab.org/
http://blog.maurogsc.eu/

[Mauro Gamberini]

<cut>

Oppure, senza UDF:

Public Sub mSelezionaRosse()

Dim c As Range
Dim rngFoglio As Range
Dim rng As Range

Set rngFoglio = Range("A1:D10")

For Each c In rngFoglio
If c.Font.Color = RGB(255, 0, 0) Then
If rng Is Nothing Then
Set rng = Range(c.Address)
Else
Set rng = Union(rng, c)
End If
End If
Next

rng.Select

Range("A20").Value = _
Evaluate("=SUM(" & rng.Address & ")")

Set c = Nothing
Set rng = Nothing
Set rngFoglio = Nothing

End Sub

Qui sempre in A20 il risultato.

[Mauro Gamberini]

Post by gimart
Perfetto, funziona benissimo. Ma .....l'appetito vien mangiando: è possibile
sommare i valori delle celle selezionate e inserire il risultato in
un'apposita cella?
Non mi mandare a quel paese :-)) .......

Proviamo.

Public Sub mSelezionaRosse()

Dim c As Range
Dim rngFoglio As Range
Dim rng As Range

Set rngFoglio = Range("A1:D10")

For Each c In rngFoglio
If c.Font.Color = RGB(255, 0, 0) Then
If rng Is Nothing Then
Set rng = Range(c.Address)
Else
Set rng = Union(rng, c)
End If
End If
Next

rng.Select

Range("A20").Value = fSommaValori(rng)

Set c = Nothing
Set rng = Nothing
Set rngFoglio = Nothing

End Sub

Public Function fSommaValori( _
ParamArray vList() As Variant _
) As Double


Dim vItem As Variant
Dim c As Range

On Error Resume Next

For Each vItem In vList
For Each c In vItem
If Not IsDate(c.Value) Then
fSommaValori = _
fSommaValori + c.Value
End If
Next
Next

Set c = Nothing
Set vItem = Nothing

End Function

Qui somma in A20.
Modifica tu a piacimento.
La UDF non somma le date ;-)
e non da errore se trova del testo.

[gimart]

Quella con UDF (ma cos'è?) va benssimo. Mauro sei grande, se non ci fossi,
bisognerebbe inventarti :-). Grazie mille.

Post by Mauro Gamberini

Post by gimart
Perfetto, funziona benissimo. Ma .....l'appetito vien mangiando: è possibile
sommare i valori delle celle selezionate e inserire il risultato in
un'apposita cella?
Non mi mandare a quel paese :-)) .......

Proviamo.
Public Sub mSelezionaRosse()
Dim c As Range
Dim rngFoglio As Range
Dim rng As Range
Set rngFoglio = Range("A1:D10")
For Each c In rngFoglio
If c.Font.Color = RGB(255, 0, 0) Then
If rng Is Nothing Then
Set rng = Range(c.Address)
Else
Set rng = Union(rng, c)
End If
End If
Next
rng.Select
Range("A20").Value = fSommaValori(rng)
Set c = Nothing
Set rng = Nothing
Set rngFoglio = Nothing
End Sub
Public Function fSommaValori( _
ParamArray vList() As Variant _
) As Double
Dim vItem As Variant
Dim c As Range
On Error Resume Next
For Each vItem In vList
For Each c In vItem
If Not IsDate(c.Value) Then
fSommaValori = _
fSommaValori + c.Value
End If
Next
Next
Set c = Nothing
Set vItem = Nothing
End Function
Qui somma in A20.
Modifica tu a piacimento.
La UDF non somma le date ;-)
e non da errore se trova del testo.
--
---------------------------
Mauro Gamberini
http://www.riolab.org/
http://blog.maurogsc.eu/

[Mauro Gamberini]

Post by gimart
Quella con UDF (ma cos'è?) va benssimo. Mauro sei grande, se non ci fossi,
bisognerebbe inventarti :-). Grazie mille.

UDF = User Defined Function
ovvero Funzione definita dall'utente,
insomma gli utenti(in questo caso io)
riscrivono una cosa che ci sarebbe già
(in questo caso la funzione SOMMA o SUM in vb)...

Io userei la seconda che ho postato...

Grazie comunque per il riscontro.

P.S. Qui in casa direbbero:
ci sei, bisognerebbe eliminarti...

[gimart]

"Mauro Gamberini" wrote:

.......

Post by Mauro Gamberini
ci sei, bisognerebbe eliminarti...

Che strano! Anche mia moglie dice così :-))