mettere cornice a unica cella particolare

[raimea]

ciao
tramite macro , nel fgl punteggiXgg,

vorrei riuscire a identificare una particolare cella
e metterle una cornice rossa grande
SENZA modificarne lo sfondo.

nel range F14:N
vorrei controllare ogni RIGA
e trovare per ogni riga, l UNICA cella
il cui valore e aumentato (indip. di quanto), rispetto
alla cella precedente di stessa colonna

a tale unica cella, vorrei venisse applicata una
grande cornice rossa

ES: nel file allegato tali celle
sono : G36 _ G42 _ i45 _ H51

vi allego il file

https://www.dropbox.com/scl/fi/bhipnadgg5mrz9swreus6/unica_cella.xlsm?rlkey=fgy42rio7wvxhqraxpo6dq0as&st=sdsrfxpe&dl=0

ciao

[Anthony47]

Ho faticato parecchio a decodificare la richiesta, che mi sono riformulata come segue:
-Esaminando le colonne F:N da riga 15 in avanti, laddove 1 sola cella della riga in esame e' superiore alla cella della riga precedente allora evidenziare con il bordo rosso spesso tale cella

Tradotto in codice:

Codice: Seleziona tutto

Sub EvidenzaUno()
Dim RCha As Long, I As Long, J As Long, LastF As Long
Dim RAA As String, RBB As String
'
LastF = Cells(Rows.Count, "F").End(xlUp).Row
'
'Reset bordi:
With Range("F14:N" & LastF).Borders
    .LineStyle = xlContinuous  'xlDouble
    .Weight = xlHairline
    .Color = 0  'xlDouble
End With
'
'Cerca celle da evidenziare:
For I = 15 To Cells(Rows.Count, "F").End(xlUp).Row
    If Cells(I, "F").Value = "-" Then Exit For
    RAA = Cells(I - 1, "F").Resize(1, 9).Address(0, 0)
    RBB = Cells(I, "F").Resize(1, 9).Address(0, 0)
    RCha = Evaluate("SUM(--(" & RBB & ">" & RAA & "))")
    If RCha = 1 Then
        For J = 6 To 14
            If Cells(I, J) > Cells(I - 1, J) Then
                Call Formatta(Cells(I, J))
'                Cells(I, J).Interior.Color = RGB(255, 0, 0)
                Exit For
            End If
        Next J
    End If
Next I
End Sub

Sub Formatta(cRan As Range)
cRan.Borders.LineStyle = xlContinuous
cRan.Borders.Weight = 4
cRan.Borders.Color = RGB(255, 0, 0)
End Sub


Va eseguito il codice della Sub EvidenzaUno.
Ho separato il codice che formatta la cella per una apertura verso una formattazione piu' complessa

Prova...

[raimea]

ciao

tutto ok
e' perfetta...

Ho faticato parecchio a decodificare la richiesta,

hai decodificato alla perfezione

grazie

[raimea]

ciao

nel fgl 3_incrementoXgg
vorrei sfruttare la macro >> EvidenzaUno
nel modulo 2

la macro EvidenzaUno :

mette una cornice NERA
quando 1 solo nome e' vincente
il suo punteggio e' l unico che e' aumentato

mette una cornice ROSSA
quando 1 solo nome e' Perdente
e' l unico che il suo punteggio NON e' aumentato

fin qui tutto ok

vorrei sfruttare la macro
facendole quindi contare
per ogni nome di riga 13

quante volte ha messo una cornice nera
unico vincente con incremento del punteggio
mettendolo in riga 9

quante volte ha messo una cornice rossa
unico perdente il suo punteggio non e' aumentato
mettendolo in riga 10

vi allego il file

https://www.dropbox.com/scl/fi/oui3lgm492zgmlrs34z88/unico_vincente.xlsm?rlkey=2ahvs1egycrvje8qxg0028ujv&st=x3f0grrt&dl=0

ciao

[Anthony47]

Ho aggiunto alla macro 1 Dim e altre 3 istruzioni, identificate dal commento ++ nel codice complessivo che accodo:

Codice: Seleziona tutto

Sub EvidenzaUnoB()
Dim RCha As Long, I As Long, J As Long, LastF As Long
Dim RAA As String, RBB As String
Dim wArr(1 To 2, 6 To 14) As Integer                             '++
'------------
'  novembre 2025 by antony47
'  serve a mettere una cornice rossa
'  quando un solo giocatore a centrato il pronostico
'  https://www.pc-facile.com/forum/viewtopic.php?f=26&t=113673&sid=b3e35948e6f0cf5379cfd6506d70ff19
'---------------------
+upgrade per riepilogo, https://www.pc-facile.com/forum/viewtopic.php?f=26&t=113673&p=669594#p669594


Sheets("3_incrementoXgg").Select
Worksheets("3_incrementoXgg").Unprotect   ' togli protez

LastF = Cells(Rows.Count, "F").End(xlUp).Row
'
'Reset bordi:
With Range("F14:N" & LastF).Borders
    .LineStyle = xlContinuous  'xlDouble
    .Weight = xlHairline
    .Color = 0  'xlDouble
End With
'
'----Cerca celle da evidenziare solo 1no ha vinto--------------
For I = 14 To Cells(Rows.Count, "F").End(xlUp).Row

    If Cells(I, "F").Value = "-" Then Exit For
   
    RAA = Cells(I - 1, "F").Resize(1, 9).Address(0, 0)
    RBB = Cells(I, "F").Resize(1, 9).Address(0, 0)
   
    RCha = Evaluate("SUM(--(" & RBB & ">" & RAA & "))")
    If RCha = 1 Then
   
        For J = 6 To 14
            If Cells(I, J) > Cells(I - 1, J) Then
           
                Call Formatta_A(Cells(I, J))
                wArr(1, J) = wArr(1, J) + 1                     '++
'                Cells(I, J).Interior.Color = RGB(255, 0, 0)
                Exit For
            End If
        Next J
    End If
Next I
'----------------------------------------------------

'----Cerca celle da evidenziare solo 1no ha sbagliato-----------
For I = 15 To Cells(Rows.Count, "F").End(xlUp).Row

    If Cells(I, "F").Value = "-" Then Exit For
   
    RAA = Cells(I - 1, "F").Resize(1, 9).Address(0, 0)
    RBB = Cells(I, "F").Resize(1, 9).Address(0, 0)
   
    RCha = Evaluate("SUM(--(" & RBB & "=" & RAA & "))")
    If RCha = 1 Then
   
        For J = 6 To 14
       
        ' If Cells(I, J) > Cells(I - 1, J) Then
       
            If Cells(I, J) = Cells(I - 1, J) Then
           
                Call Formatta_B(Cells(I, J))
                wArr(2, J) = wArr(2, J) + 1                     '++
               
                Exit For
            End If
        Next J
    End If
Next I
Range("F9:N10").Value = wArr                                   '++
End Sub


Prova...

[raimea]

ciao
e' tutto ok

super perfetta... ottimo...

grazie