excel 2003

Question

Buongiorno,

devo estrarre da un elenco posizionato in BA5:BP200 solo le righe che hanno il font di colore rosso e copiarle in CA5:CP5

Si può ottenere con un codice VBA ?

Il carattere delle righe è il classico font rosso e non è ottenuto con la formattazione condizionale.

Ho visto che la versione excel minimale dovrebbe essere 2007 va bene ugualmente perchè poi in excel 2003 attiverei la compatibilità

Grazie, Pier

Answer 1

Ciao Pierluigi,

devo estrarre da un elenco posizionato in BA5:BP200 solo le righe che hanno il font di colore rosso e copiarle in CA5:CP5

Si può ottenere con un codice VBA ?

Il carattere delle righe è il classico font rosso e non è ottenuto con la formattazione condizionale.

Ho visto che la versione excel minimale dovrebbe essere 2007 va bene ugualmente perchè poi in excel 2003 attiverei la compatibilità

Peiva qualcosa del genere:

• Alt+F11 per aprire l'editor di VBA
• Alt+IMper inserire un nuovo modulo di codice
• Nel nuovo modulo vuoto, incolla il seguente codice:

'=========>>

Option Explicit

'--------->>

Public Sub Tester()

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim srcRng As Range, destRng As Range

    Dim copyRng As Range, rCell As Range

    Dim iRow As Long, iCols As Long, LRow As Long

    Dim CalcMode As Long

    Const sFoglio As String = "Foglio1"                              '<<=== Modifica

    Const sElenco As String = "BA5:BP200"

    Const sDestinazione As String = " CA5"

    Set WB = ThisWorkbook

    Set SH = WB.Sheets(sFoglio)

    With SH

        Set srcRng = .Range(sElenco)

        Set destRng = .Range(sDestinazione)

    End With

    With srcRng

        iRow = srcRng.Row

        iCols = .Columns.Count

    End With

    LRow = LastRow(SH, srcRng)

    Set srcRng = srcRng.Resize(LRow - iRow + 1)

    For Each rCell In srcRng.Columns(1).Cells

        With rCell

            If Application.CountA(.Resize(1, iCols)) Then

                If .Font.Color = vbRed Then

                    If copyRng Is Nothing Then

                        Set copyRng = rCell

                    Else

                        Set copyRng = Union(rCell, copyRng)

                    End If

                End If

            End If

        End With

    Next rCell

    If Not copyRng Is Nothing Then

        On Error GoTo XIT

        With Application

            CalcMode = .Calculation

            .Calculation = xlCalculationManual

            .ScreenUpdating = False

        End With

        Intersect(copyRng.EntireRow, srcRng).Copy Destination:=destRng

    Else

        '\ Nulla da copiare! Fai niente

    End If

XIT:

    With Application

        .Calculation = CalcMode

        .ScreenUpdating = True

    End With

End Sub

'--------->>

Public Function LastRow(SH As Worksheet, _

                        Optional Rng As Range)

    If Rng Is Nothing Then

        Set Rng = SH.Cells

    End If

    On Error Resume Next

    LastRow = Rng.Find(What:="*", _

                       after:=Rng.Cells(1), _

                       Lookat:=xlPart, _

                       LookIn:=xlFormulas, _

                       SearchOrder:=xlByRows, _

                       SearchDirection:=xlPrevious, _

                       MatchCase:=False).Row

    On Error GoTo 0

End Function

'<<========= 

• Alt+Q per chiudere l'editor di VBA e tornare a Excel
• Salva il file con l’estensione xlsm
• Alt+F8 per aprire  la finestra di gestione delle macro
• Seleziona Tester | Esegui

Questo codice dovrebbe funzionare altrettanto bene sia con Excel 2003 che una versione successiva.

Potresti scaricare il mio file di prova Pierluigi20170421.xlsm a: 

https://www.dropbox.com/s/ld2mri79tua891o/Perliugi20170421.xlsm?dl=0

===

Regards,

Norman

Answer 2

Ciao Poer,

funzionato tutto al primo colpo. Mi spiace solo che ho intitolato la richiesta EXCEL 2003 anzichè postare l'argomento che reputo prezioso per molti, visto che da mie ricerche fatte in rete non ho trovato nulla di simile.

L'estrazione tramite colore di riga alcuni l'hanno criticata.

Se penso che volevo tramite il comando SE trovare il colore di cella e quindi mettere una x se il riscontro era vero e in fase successiva far estrarre le righe con la x ... Invece con la tua risposta in pochi secondi ho ottenuto il risultato voluto.

Benissimo!  la morale è viene sempre qua - non accettare mai alternative inferiori! :-))

Se riesci a cambiare il titolo da EXCEL 2003 ed inserire ESTRAZIONE delle sole righe colorate forse potrebbe servire anche ad altri in caso di ricerca.

Comunque, con EXCEL 2003 non sono riuscito ad utilizzare il comando SE per trovare il colore rosso del carattere.

Quindi se per informazione poniamo che in A1 abbia una scritta in rosso ed in B1 metto SE.... forse potrebbe servirmi per un altro lavoro e non necessariamente per un database.

Mi fa piacere che tu abbia risolto il problema e ti ringrazio per il cortese riscontro.

Per chiudere questo thread, vorrei chiederti gentilmente di contrassegnare la mia risposta come Risposta preferita. In questo modo, tu aiuterai anche coloro che potessero cercare soluzioni ai problemi simili negli archivi della Community.

Se vorresti avere un modo per selezionare celle colorate per altri scopi e campattibie con Excel 2003, ti consiglierei di aprire un nuovo thread dedicato.

===

Regards,

Norman

Answer 3

Grazie Norman,

funzionato tutto al primo colpo. Mi spiace solo che ho intitolato la richiesta EXCEL 2003 anzichè postare l'argomento che reputo prezioso per molti, visto che da mie ricerche fatte in rete non ho trovato nulla di simile.

L'estrazione tramite colore di riga alcuni l'hanno criticata.

Se penso che volevo tramite il comando SE trovare il colore di cella e quindi mettere una x se il riscontro era vero e in fase successiva far estrarre le righe con la x ... Invece con la tua risposta in pochi secondi ho ottenuto il risultato voluto.

Se riesci a cambiare il titolo da EXCEL 2003 ed inserire ESTRAZIONE delle sole righe colorate forse potrebbe servire anche ad altri in caso di ricerca.

Comunque, con EXCEL 2003 non sono riuscito ad utilizzare il comando SE per trovare il colore rosso del carattere.

Quindi se per informazione poniamo che in A1 abbia una scritta in rosso ed in B1 metto SE.... forse potrebbe servirmi per un altro lavoro e non necessariamente per un database.

Grazie ancora, Pier