Ripetere istruzione

Hai un problema con Excel?

Nuova discussione

Ripetere istruzione
di slevin19 (utente non iscritto) data: 04/07/2013 15:33:35
Salve a tutti,
sono un neofita nell'utilizzo di VBA e avrei bisogno di una mano per ripetere la routine sub che ho scritto dalla cella D22 alla D25...esiste un modo per ripeterla senza dover riscrivere una funzione if per ogni cella e rispettiva selezione?

Grazie in anticipo a tutti per l'aiuto

Sub Evidenziatore_Automatico()

Sheets("Foglio2").Select
 riga
    If Range("D22") = "p" Or Range("D22") = "c" Then
            Range("D22:G22").Select
            With Selection.Interior
                .ColorIndex = 34
                .Pattern = xlSolid
            End With
        Else
            Range("D22:G22").Select
            With Selection.Interior
                .ColorIndex = 2
            End With
            
    End If

End Sub

di slevin19 (utente non iscritto) data: 04/07/2013 16:04:09
ok dopo cinque minuti di pausa, sono riuscito a risolvere il problema adottando le istruzioni FOR per ripetere il ciclo e CELLS per selezionare le celle invece di RANGE (vedi codice sotto)

  For riga = 7 To 21
  For colonna = 1 To 6
     
        If Cells(riga, 1) = "p" Or Cells(riga, 1) = "c" Then
            Cells(riga, colonna).Select
                With Selection.Interior
                .ColorIndex = 34
                .Pattern = xlSolid
                End With
            Else
                Cells(riga, colonna).Select
                With Selection.Interior
                .ColorIndex = 2
                End With
        End If

di Vecchio Frac data: 04/07/2013 16:18:47
Una versione alternativa.

Sub Evidenziatore_Automatico_by_vfrac()
Dim v As Variant

    [A7:G21].Interior.ColorIndex = 2
    
    For Each v In [A7:A21]
        If v Like "[pc]" Then
            With Range(Cells(v.Row, 1), Cells(v.Row, 6)).Interior
                .ColorIndex = 34
                .Pattern = xlSolid
            End With
        End If
    Next

End Sub

di Vecchio Frac data: 04/07/2013 16:22:15
Pardon... una piccola svista ^_^
Il codice precedente è da correggere come segue, altrimenti la ricerca di "p" o "c" viene fatta solo in colonna A (mentre tu vuoi cercare nell'intero range).
For Each v In [A7:F21]

di Vecchio Frac data: 04/07/2013 16:37:30
Un'altra soluzione ancora, se i tempi di esecuzione sono critici (questa versione è velocissima anche su un range di righe enorme, mentre la precedente scorre comunque tutte le celle del range) ^_^

Sub Evidenziatore_Automatico_by_vfrac2()
Dim c As Range, f As String, v As Variant

    [A7:F21].Interior.ColorIndex = 2
    
    For Each v In Array("p", "c")
        Set c = [A7:F21].Find(v)
        If Not c Is Nothing Then
            f = c.Address
            Do
                
                With Range(Cells(c.Row, 1), Cells(c.Row, 6)).Interior
                    .ColorIndex = 34
                    .Pattern = xlSolid
                End With
                Set c = [A7:F21].FindNext(c)
            Loop While Not c Is Nothing And f <> c.Address
        End If
    Next

End Sub

di Vecchio Frac data: 04/07/2013 16:44:04
Per darti un'idea dei tempi, col primo metodo a controllare il range A7:IV65000 ci ho messo 58,84 secondi, con solo quattro righe da evidenziare (se ci mettevo qualche migliaio di righe da evidenziare i tempi si allungavano).
Col secondo metodo (basato su Find) per lo stesso range e con gli stessi dati ci ho messo 0,52 secondi (hai letto bene: un minuto a fronte di mezzo secondo ^_^)
di Slevin19 (utente non iscritto) data: 05/07/2013 18:20:56
Grazie Vecchio Frac!!
Beh...direi che molto meglio la seconda soluzione!
Credo che ci sia una bella differenza nei tempi di calcolo, considerando che la prima routine ci ha impiegato quasi un minuto per un piccolo intervallo di celle!! :S

Unica nota: ho dovuto cambiare il range di c in [A7:A21] poichè a me interessava la ricerca solo nella prima colonna della tabella e non in tutte, altrimenti con il range [A7:F21] se inserivo una p o una c in una colonna diversa dalla prima, evidenziava ugualmente la riga...

Grazie ancora

Vuoi Approfondire?