Evidenziazione valori simili da cella selezionata

[thunderPartecipante thunder]

Ciao, in un foglio ho delle celle il cui contenuto è separato da un trattino nel seguente modo "X-Y". Sto cercando una funzione per cui selezionando una qualsiasi cella non vuota, vengano evidenziate tutte le celle con i valori a corrispondenza esatta prima del trattino in blu e quelli successivi al trattino in rosso. Allego un file di esempio che sicuramente è più chiaro dove la cella selezionata è "A2"

Allegati:

You must be logged in to view attached files.

[Marius44Moderatore Marius44 Karma: 58 pts]

Ciao

Ritengo possa farsi solo con VBA. Ecco il codice

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("A1:A10")) Is Nothing Then
  Dim txt, axt
  Dim i As Long
  txt = Split(ActiveCell.Value, "-")
  For i = 1 To 10
    If i <> Target.Row And Cells(i, 1) <> "" Then
      axt = Split(Cells(i, 1).Value, "-")
      If txt(0) = axt(0) Then Cells(i, 1).Interior.ColorIndex = 3
      If txt(0) = axt(1) Then Cells(i, 1).Interior.ColorIndex = 6
    End If
  Next i
Else
  Range("A:A").Interior.ColorIndex = xlNone
End If
End Sub

E' impostato per l'intervallo A1:A10

Seleziona una cella.

Fai sapere. Ciao,

Mario

Allegati:

You must be logged in to view attached files.

[thunderPartecipante thunder]

ciao, innanzitutto grazie. Il codice funziona sulla colonna A come hai indicato. Ho provato ad aumentare l'intervallo dell'intersezione  

Range("A1:H100")

ma mi da errore "Indice non incluso nell'intervallo"

If txt(0) = axt(0) Then

[Marius44Moderatore Marius44 Karma: 58 pts]

Ciao

L'intervallo da te indicato non è congruo con l'esempio postato in precedenza. Per Excel, e mi sembra ovvio, una cosa è un intervallo di una decina di cells SU UNA COLONNA altra cosa un intervallo di centinai di celle SU OTTO COLONNE.

Il mio esempio confronta il contenuto della cella attiva col contenuto delle altre celle dell'intervallo. Ora, se l'intervallo è formato da più colonne ... occorre farlo sapere ad Excel  

Studiaci un po' e poi al caso ci sentiamo per correggere eventualmente quanto da te fatto.

 

Ciao,

Mario

[albatros54Moderatore albatros54 Karma: 89 pts]

Marius44 ha scritto:

Ora, se l'intervallo è formato da più colonne ... occorre farlo sapere ad Excel  

Studiaci un po' e poi al caso ci sentiamo per correggere eventualmente quanto da te fatto.

condivido quanto detto da Mario(saluto), credo di avere il codice che fa quello che hai chiesto, lo volevo postare , ma dopo il posto di Mario mi sono fermato.

Devi dire ad excel che il range che tu vuoi controllare non si trova su di una singola colonna e piu righe , ma bensi che è formato da un numero di colonne maggiore di una  quindi il tuo range ceh devi controllare è una matrice . Una volta che excel sa che deve controllare una matrice devi trovare il numero di righe e il numero di colonne per poter fare due cicli For per controllare tutti i valori delle celle che formano la matrice....canna da pesca fornita , comunque , se qualcuno a qualche cosa da dire noi siamo QUA, come dice il due comico Ficarra e Picone

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

[Marius44Moderatore Marius44 Karma: 58 pts]

Ciao

Non impaurirti. @albatros (ciao Santo) l'ha fatta più difficile di quanto in effetti sia.

Provo a darti un'imbeccata. Setta il tuo intervallo, per esempio così Set mioInterv=Range("A1:H100")

Poi esegui un ciclo For Each c in mioInterv (ricordati di escludere la cella attiva)

 

Dai, prova.

Ciao,

Mario

[thunderPartecipante thunder]

ci sto provando..vi faccio sapere appena riesco. Solo una cosa quindi tutta la parte 

  For i = 1 To 10
    If i <> Target.Row And Cells(i, 1) <> "" Then

non serve più giusto?

[thunderPartecipante thunder]

ciao purtroppo non sono riuscito. Metto risolto comunque perché la prima soluzione proposta rispondeva alla domanda.

[albatros54Moderatore albatros54 Karma: 89 pts]

Perchè abbandonare e darsi per vinto!

ti posto il codice che devi inserire sul foglio1 del file che hai postato , se ho capito quello che chiedi

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim txt, axt
    Dim i As Integer, x As Integer, y As Integer
    Dim e As Integer
    Dim rng As Range
    Set rng = Range("A1:h36")
    If Not Intersect(Target, rng) Is Nothing Then
        y = rng.Columns.Count
        x = rng.Rows.Count
        txt = Split(ActiveCell.Value, "-")
        For i = 1 To y
            For e = 1 To x
                If i <> Target And Cells(e, i) <> "" Then
                    axt = Split(Cells(e, i).Value, "-")
                    If txt(0) = axt(0) Then Cells(e, i).Interior.ColorIndex = 3
                    If txt(0) = axt(1) Then Cells(e, i).Interior.ColorIndex = 6
                End If
            Next
        Next
    Else
        rng.Interior.ColorIndex = xlNone
    End If
End Sub

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

[Marius44Moderatore Marius44 Karma: 58 pts]

Ciao

Oltre all'ottima soluzione di @albatros (ciao) ti posto la mia (che, in linea di massima, è uguale alla precedente ma con un ciclo in più

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("A:C")) Is Nothing Then
  Dim txt, axt
  Dim i As Long, j As Long, ur As Long
  txt = Split(ActiveCell.Value, "-")
  For j = 1 To 3
    ur = Cells(Rows.Count, j).End(xlUp).Row
    For i = 1 To ur
      If i <> Target.Row And Cells(i, j) <> "" Then
        axt = Split(Cells(i, j).Value, "-")
        If txt(0) = axt(0) Then Cells(i, j).Interior.ColorIndex = 3
        If txt(0) = axt(1) Then Cells(i, j).Interior.ColorIndex = 6
      End If
    Next i
  Next j
Else
  Range("A:C").Interior.ColorIndex = xlNone
End If
End Sub

Ti riporto una frase di Nelson Mandela: “Un vincitore è un sognatore che non si è mai arreso.”

Prendine buona nota.

Fai sapere. Ciao,

Mario

Allegati:

You must be logged in to view attached files.

[Marius44Moderatore Marius44 Karma: 58 pts]

Ciao

Sempre con lo stesso principio ma, come avevo detto, assegnando un nome all'intervallo e con un ciclo For Each

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim txt, axt
Dim table As Range, c As Range
Dim i As Long, j As Long, ur As Long
Set table = Range("A1:C10")
If Not Intersect(Target, table) Is Nothing Then
  table.Interior.ColorIndex = xlNone
  txt = Split(ActiveCell.Value, "-")
  For Each c In table
    If c.Address <> Target.Address And c <> "" Then
      axt = Split(c, "-")
      If txt(0) = axt(0) Then c.Interior.ColorIndex = 3
      If txt(0) = axt(1) Then c.Interior.ColorIndex = 6
    End If
  Next
Else
  table.Interior.ColorIndex = xlNone
End If
Set table = Nothing
End Sub

 

Ciao,

Mario

[OscarPartecipante Oscar Karma: 45 pts]

Scusate Ragazzi se mi intrometto mettendo anche il mio esempio 

Allegati:

You must be logged in to view attached files.

[Marius44Moderatore Marius44 Karma: 58 pts]

Ciao

Per sfruttare ancora di più il suggerimento di @oscar (che saluto) la macro si può implementare per far colorare entrambe le lettere con colori differenti (si può anche fare con un intervallo maggiore)

Questo il codice "manipolato"   

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.ScreenUpdating = False
    Rosso = Selection.Value
    Dim uRiga As Long
    Dim Riga As Long
    Dim Numeri '
    Dim valore
    Dim x
    Dim i
  
    uRiga = Cells(Rows.Count, 1).End(xlUp).Row
    Range("A1:A" & uRiga).Font.ColorIndex = xlAutomatic
    Range("A1:A" & uRiga).Interior.ColorIndex = xlNone
    Range("A1:A" & uRiga).Font.Bold = False

    For Riga = 1 To 7
      Numeri = Split(Trim(Cells(Riga, 1)))
      x = 1
      For i = 0 To 2
        valore = Numeri(i)
        If Left((Rosso), 1) = valore Then
          Cells(Riga, 1).Characters(Start:=x, Length:=2).Font.Color = vbRed
          Cells(Riga, 1).Characters(Start:=x, Length:=2).Font.Bold = True
        ElseIf Right(Trim(Rosso), 1) = valore Then
          Cells(Riga, 1).Characters(Start:=x, Length:=2).Font.Color = vbGreen
          Cells(Riga, 1).Characters(Start:=x, Length:=2).Font.Bold = True
        End If
        x = x + 2
      Next i
      x = 1
    Next Riga
    Application.ScreenUpdating = True
End Sub

Ciao,

Mario

[OscarPartecipante Oscar Karma: 45 pts]

`Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 Application.ScreenUpdating = False
 Rosso = Selection.Value
    Dim uRiga As Long
    Dim Riga As Long
    Dim Numeri '
    Dim valore
    Dim x
    Dim i
  
    uRiga = Cells(Rows.Count, 1).End(xlUp).Row
    Range("A1:A" & uRiga).Font.ColorIndex = xlAutomatic
    Range("A1:A" & uRiga).Interior.ColorIndex = xlNone
    Range("A1:A" & uRiga).Font.Bold = False

    For Riga = 1 To 7
        Numeri = Split(Trim(Cells(Riga, 1)))
            x = 1
            For i = 0 To 2
                valore = Numeri(i)
                       If Left((Rosso), 1) = valore Then
                            Cells(Riga, 1).Font.Color = vbBlue   '<<<< aggiungo solamente questa riga
                            Cells(Riga, 1).Characters(Start:=x, Length:=2).Font.Color = vbRed
                            Cells(Riga, 1).Characters(Start:=x, Length:=2).Font.Bold = True
                       End If
                   x = x + 2
            Next i
         x = 1
    Next Riga
    Application.ScreenUpdating = True
End Sub`

Ciao Mario

Ho visto la modifica , io non avrei fatto così perchè in certi casi ti colora anche la seconda corrispondenza (avrei colorato tutti i caratteri di colore blu , con il codice all'inizio , e la riga sucessiva   mi ripristina la corrispondenza in rosso ( Questa soluzione la uso per il controllo vincite del lotto , dove voglio avere l'ambata in colore Rosso  gli Ambi e terni blu , e se fosse presente l'Ambata , me la mette in Rosso

 

Allegati:

You must be logged in to view attached files.

[thunderPartecipante thunder]

Ciao a tutti! Beh che dire vi ringrazio tutti per l'interesse ed il funzionamento dei vostri codici!

[Autore]

Articoli