Individuare intersezioni di Range

[Sgrubak]

Ciao a tutti,
sull'onda di questa discussione, mi domandavo: esistono metodi alternativi più efficienti rispetto all'uso di Intersect?

Io la condizione dell'If la scriverei proprio Target.Address = cell.Address, così da evitare l'Intersect e il confronto negato contro Nothing. Verifico l'uguaglianza tra due stringhe e via andare.

L'idea che mi sono fatto è: con questo sistema impongo a caricare in un registro il valore all'indirizzo della proprietà, fare altrettanto con l'altra, confrontarli ed infine usare il risultato della comparazione. Con l'Intersect, dovendo cercare una sovrapposizione dei due Range e rendere un ennesimo Range, confrontare e poi negare il risultato è necessariamente più impegnativo.

Un piccolo test che ho pensato è

Sub t()
Dim r1 As Range, r2 As Range
Dim j As Long
Dim res As Boolean
Dim t As Single

j = 100000
Set r1 = Range("A1")
Set r2 = Range("A2")

Debug.Print "Cella SINGOLA"
t = Timer
For i = 0 To j
    res = Not Intersect(r1, r2) Is Nothing
Next i
Debug.Print Timer - t

t = Timer
For i = 0 To j
    res = r1.Address = r2.Address
Next i
Debug.Print Timer - t

Set r2 = Range("A:A")

Debug.Print "Cella in COLONNA"
t = Timer
For i = 0 To j
    res = Not Intersect(r1, r2) Is Nothing
Next i
Debug.Print Timer - t

t = Timer
For i = 0 To j
    res = r1.Column = 1
Next i
Debug.Print Timer - t

End Sub

Voi avete metodi alternativi? A me i risultati, al netto di errori nel codice, sembrano confermare il mio ragionamento. La Intersect è dispendiosa il doppio rispetto all'Address e 9-10 volte rispetto alla Column.

Vi torna?

 

[Terio]

Vi torna?

Mi torna, nel caso di range, anche multipli, penso che l'intersezione sia la strada migliore, almeno in termini di praticità.
Per le singole celle il confronto diretto non ha eguali, ma altri metodi, per quanto detto sopra, non penso siano percorribili. In GS mi sono trovato proprio di fronte a questa esigenza e se la definizione di un oggetto con top, bottom, left e right è utile per un intervallo, in caso di intervalli multipli perde di efficienza, a mio avviso.

Ciao.

 

[Sgrubak]

in caso di intervalli multipli perde di efficienza, a mio avviso.

Aggiungo anche il caso di intervalli dinamici.

Si ipotizzi in A1 => FILTRO(C:D;C:C=E1)
Ora, l'altezza in righe di A1# varierà... Con un codice simile a

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("A1#")) Is Nothing Then
    Range("A1#").Interior.ColorIndex = xlColorIndexNone
    Intersect(Target.EntireRow, Range("A1#")).Interior.Color = RGB(255, 0, 0)
End If
End Sub

Sfruttare in alternativa Address è escluso. Nun se po' fà! Richiederebbe di pasticciare le stringhe e tanto vale...
Sfruttare in alternativa numero di riga e colonna richiede il quadruplo confronto e diventa un bello sbattimento, anche se a sentimento scommetterei che è comunque più performante. In fin dei conti se Column vs Intersect vince in velocità di 10 volte, moltiplicare per 4 i confronti dovrebbe rendere tutto più efficiente di 2,5 volte (forse anche di più nei casi in cui l'intersezione non c'è)

Mi resta il cruccio della "decolorazione" ma ci devo ancora ragionare bene...

 

[scossa]

Mi resta il cruccio della "decolorazione" ma ci devo ancora ragionare bene...

Probabilmente non ho capito, ma non basta:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Intersect(Target, Range("A1#")) Is Nothing Then
    Range("A1#").Interior.ColorIndex = xlColorIndexNone
  Else
    Intersect(Target.EntireRow, Range("A1#")).Interior.Color = RGB(255, 0, 0)
  End If
End Sub

Su Excel 2010 ovviamente Range("A1#") non è gradito, ma sono fiducioso che la proposta funzioni.

 

[Sgrubak]

ma non basta:

Purtroppo no. Di sicuro la decolorazione va fatta prima di ogni cosa. Per come l'hai impostata, il range resta sempre colorato.
Il punto problematico è gestire la decolorazione quando il range che è stato precedentemente selezionato finisce "fuori" dal nuovo A1#.
Mi spiego meglio. Sfruttando sempre l'esempio della FILTRO, immaginiamo di avere il seguente scenario

Ora procediamo con il variare il criterio del filtro.

Il nuovo A1# è più piccolo del precedente e quindi a decolorare ci perdiamo qualche riga.
Potremmo spostare la decolorazione fuori dall'If, ma seppur funzionale, non mi ispira. Se mi immagino la FILTRO come una ListBox, non deve perdere la selezione se mi sposto su un altro controllo.
Potremmo ricorrere ad una variabile Static per memorizzare le ultime celle colorate e decolorarle in un secondo momento

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Static lastIntersection As Range
  If Not Intersect(Target, Range("A1#")) Is Nothing Then
    If Not lastIntersection Is Nothing Then lastIntersection.Interior.ColorIndex = xlColorIndexNone
    Set lastIntersection = Intersect(Target.EntireRow, Range("A1#"))
    lastIntersection.Interior.Color = RGB(255, 0, 0)
  End If
End Sub

e così già miglioriamo in pochetto. Rimane il fatto che la colorazione resta "fuori" dalla FILTRO se questa si accorcia, ma almeno si aggiusta nel caso in cui io vado a selezionare una o più nuove righe in A1#.
L'ideale sarebbe che la colorazione si resettasse quando vario il criterio di filtro, ma:
1) se ricorro alle Range("A1#").Precedents di nuovo perdo la colorazione anche quando seleziono qualcosa nella tabella da filtrare (nel caso di prima D1:E10)
2) se fisso il range C1 perdo di "dinamicità". Se sposto il criterio ad esempio in C2 devo modificare il codice.
Potrei ricorrere ad un range nominato, che forse è l'unica soluzione. Ho sempre lo svantaggio che, se sposto la cella nel foglio, devo farlo trascinando o modificando la definizione del nome, ma il codice non lo tocco più.

Option Explicit
Dim lastIntersection As Range

Private Sub Worksheet_Change(ByVal Target As Range)
If Not lastIntersection Is Nothing Then
    If Target.Address = [criterioFiltro].Address Then
        lastIntersection.Interior.ColorIndex = xlColorIndexNone
    End If
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect(Target, Range("A1#")) Is Nothing Then
    If Not lastIntersection Is Nothing Then lastIntersection.Interior.ColorIndex = xlColorIndexNone
    Set lastIntersection = Intersect(Target.EntireRow, Range("A1#"))
    lastIntersection.Interior.Color = RGB(255, 0, 0)
  End If
End Sub

 

[scossa]

Il punto problematico è gestire la decolorazione quando il range che è stato precedentemente selezionato finisce "fuori" dal nuovo A1#.

Sinceramente, avendo Excel 2010, quanto sopra non mi è chiaro.
Se alleghi il file che stai usando, nei prossimi giorni posso mettere le mani su un pc con Office 2024 e mi tolgo la curiosità.

Potrei ricorrere ad un range nominato, che forse è l'unica soluzione. Ho sempre lo svantaggio che, se sposto la cella nel foglio, devo farlo trascinando o modificando la definizione del nome

Ma il vecchio ctrl+x e ctrl+v ?
Definisci C1 come crit, la formula come =FILTRO(D1:E10;D1:D10=crit) poi se selezioni C1 -> ctrlx e ctrl+v e crit. seguirà lo spostamento.

P.S.: così potrebbe funzionare?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Range("A1#").Interior.ColorIndex = xlColorIndexNone
  If Not Intersect(Target, Range("A1#")) Is Nothing Then
      Intersect(Target.EntireRow, Range("A1#")).Interior.Color = RGB(255, 0, 0)
  End If
End Sub

 

[scossa]

P.S.: così potrebbe funzionare?

@Sgrubak : per caso hai potuto verificare se funziona?

 

[Sgrubak]

hai potuto verificare se funziona?

Perdonami, mi era sfuggito di mente.

Ma il vecchio ctrl+x e ctrl+v ?

Si, è equivalente. L'idea di base era appunto di passare da un range nominato.

così potrebbe funzionare?

Si, ma

seppur funzionale, non mi ispira. Se mi immagino la FILTRO come una ListBox, non deve perdere la selezione se mi sposto su un altro controllo.

e così facendo invece la "selezione" la perdo. Lei deve restare li fino a quando non effettuo effettivamente una nuova selezione interno al range espanso della FILTRO. Se mi "muovo" fuori, il colore deve restare.

Nel file ho fatto che mettere tutto.

 

[scossa]

e così facendo invece la "selezione" la perdo. Lei deve restare li fino a quando non effettuo effettivamente una nuova selezione interno al range espanso della FILTRO. Se mi "muovo" fuori, il colore deve restare.

Allora non basta questo semplice codice?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect(Target, Range("A1#")) Is Nothing Then
    Range("A1#").Interior.ColorIndex = xlColorIndexNone
    Intersect(Target.EntireRow, Range("A1#")).Interior.Color = RGB(255, 0, 0)
  End If
End Sub

 

[Sgrubak]

Allora non basta questo semplice codice?

No, resta il problema del post #5

 

[scossa]

No, resta il problema del post #5

Ok, finalmente ho potuto mettere le mani su un pc con Excel 2024 ed ho capito il problema.
Mi sembra che il comportamento desiderato sia questo:

che si può ottenere anche col seguente codice:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = [crit].Address Then
    Range(Range("A1").CurrentRegion.Address & " A:B").Interior.ColorIndex = xlColorIndexNone
  End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect(Target, Range("A1#")) Is Nothing Then
    Range(Range("A1").CurrentRegion.Address & " A:B").Interior.ColorIndex = xlColorIndexNone
    Intersect(Target.EntireRow, Range("A1#")).Interior.Color = RGB(255, 0, 0)
  End If
End Sub

Potresti cortesemente confermare?

 

[Sgrubak]

Potresti cortesemente confermare?

Esatto. È la stessa logica che ho applicato al codice al post #5. Io ho preferito memorizzare l'ultima intersezione e non ricalcolarla ogni volta. Con il codice come lo hai impostato tu, se devo modificare il calcolo dell'intersezione devo modificare più roba e io sono estremamente pigro.