Ho un'elenco dal quale vorrei selezionare tutte assieme le celle contenenti
il carattere rosso; ho a disposizione excel 2003

Video: http://www.jlathamsite.com/uploads/R...ttereRosso.avi

Sub RicercaCarattereRosso()
Dim ChosenCells As Range
Dim LastRow As Long
Dim RowOffset As Long
Dim BaseCell As String
Const Rosso = 3 ' Red

BaseCell = Left(ActiveCell.Address, InStr(2, ActiveCell.Address, "$") -
1) & "65536"
LastRow = Range(BaseCell).End(xlUp).Row
BaseCell = Left(ActiveCell.Address, InStr(2, ActiveCell.Address, "$") -
1) & "1"
On Error Resume Next
Do Until Range(BaseCell).Offset(RowOffset, 0).Row LastRow
If Not (IsEmpty(Range(BaseCell).Offset(RowOffset, 0))) And _
Range(BaseCell).Offset(RowOffset, 0).Font.ColorIndex = Rosso Then
'will error on 1st match
Set ChosenCells = Union(ChosenCells,
Range(BaseCell).Offset(RowOffset, 0))
If Err < 0 Then
Set ChosenCells = Range(BaseCell).Offset(RowOffset, 0)
Err.Clear
End If
End If
RowOffset = RowOffset + 1
Loop
On Error GoTo 0 ' clear trapping
If Not (ChosenCells Is Nothing) Then
ChosenCells.Select
Else
MsgBox "No Matches"
End If

End Sub

"Ivanobrb" wrote:

Ho un'elenco dal quale vorrei selezionare tutte assieme le celle contenenti
il carattere rosso; ho a disposizione excel 2003

Video in Media Player may require codec:
( Il video nel lettore multimediale può richiedere il codec: )
http://www.techsmith.com/download/codecs.asp


"JLatham" wrote:

Video: http://www.jlathamsite.com/uploads/R...ttereRosso.avi

Sub RicercaCarattereRosso()
Dim ChosenCells As Range
Dim LastRow As Long
Dim RowOffset As Long
Dim BaseCell As String
Const Rosso = 3 ' Red

BaseCell = Left(ActiveCell.Address, InStr(2, ActiveCell.Address, "$") -
1) & "65536"
LastRow = Range(BaseCell).End(xlUp).Row
BaseCell = Left(ActiveCell.Address, InStr(2, ActiveCell.Address, "$") -
1) & "1"
On Error Resume Next
Do Until Range(BaseCell).Offset(RowOffset, 0).Row LastRow
If Not (IsEmpty(Range(BaseCell).Offset(RowOffset, 0))) And _
Range(BaseCell).Offset(RowOffset, 0).Font.ColorIndex = Rosso Then
'will error on 1st match
Set ChosenCells = Union(ChosenCells,
Range(BaseCell).Offset(RowOffset, 0))
If Err < 0 Then
Set ChosenCells = Range(BaseCell).Offset(RowOffset, 0)
Err.Clear
End If
End If
RowOffset = RowOffset + 1
Loop
On Error GoTo 0 ' clear trapping
If Not (ChosenCells Is Nothing) Then
ChosenCells.Select
Else
MsgBox "No Matches"
End If

End Sub

"Ivanobrb" wrote:

Ho un'elenco dal quale vorrei selezionare tutte assieme le celle contenenti
il carattere rosso; ho a disposizione excel 2003