È soltanto un Pokémon con le armi o è un qualcosa di più? Vieni a parlarne su Award & Oscar!

Excel Forum Per condividere esperienze su Microsoft Excel

Ricerca del Terno di Somma

  • Messaggi
  • OFFLINE
    Xeroxs64
    Post: 82
    Registrato il: 20/01/2020
    Età: 60
    Utente Junior
    2016
    00 18/03/2020 15:43
    Buon Pomeriggio a Tutti Voi,

    Volevo un aiuto per una ricerca nel solito quadro estrazionale di alcuni terni di somma come da esempi nel file che allego

    Vorrei sapere se con una VBA si possono evidenziare questo tipo di somme tra due numeri che devono essere isotopi (stessa posizione) ed il loro totale deve essere presente in una delle due Ruote in qualunque posizione.

    questo mi darà modo di ridurre il tempo di ricerca che fatto a mano toglie del tempo alle elaborazioni e dei calcoli.


    Spero che qualcuno possa aiutarmi in questa ricerca per poter modificare un mio metodo di calcolo.

    Grazie comunque come sempre.
  • OFFLINE
    by sal
    Post: 5.852
    Registrato il: 14/11/2004
    Utente Master
    Office 2019
    00 18/03/2020 19:52
    Somma
    Ciao vedi se va bene, questi 2 risultati




    come metodo di ricerca ho usato la stessa riga del numero cercato ed una colonna differente, non so se va bene in questo modo

    inserisci il numero nella cella gialle e premi "Vai"

    ti allego il file

    Ciao By Sal [SM=x423051]
    [Modificato da by sal 18/03/2020 19:53]
    se ti piace la soluzione sostienici con una DONAZIONE a piacere. Grazie clicca qui
  • OFFLINE
    Xeroxs64
    Post: 83
    Registrato il: 20/01/2020
    Età: 60
    Utente Junior
    2016
    00 19/03/2020 05:40
    Buongiorno, anche se è presto

    Direi che va bene, l'ho testata e portata sul file delle mie ricerche , ho riscontrato solo un anomalia nel mio file che avevo allegato nel pannello di destra avevo evidenziato la ricerca con l 80 dato da 74 6 stessa colonna ma evidenzia solo l 80.
    Ho provato altre date con l 80 e le evidenzia con i suoi ambi per il resto direi che per me è un ottima soluzione, volevo chiederti solo una piccola variante se quando trova la condizione si può evidenziare solo con il testo rosso il nome delle Ruote (per ottimizzare la visuale della ricerca)

    Poi secondo Te quel tipo di ricerca riesco a farla modificandola solo se il terno è su una singola ruota, ad esempio se su Torino trova il 90 con i numeri 65 e 25 in ogni posizione ma stessa ruota o per excel stessa riga.

    Grazie davvero per avermi aiutato anche in questa ricerca.
  • OFFLINE
    by sal
    Post: 5.853
    Registrato il: 14/11/2004
    Utente Master
    Office 2019
    00 19/03/2020 07:07
    somma terni
    Ciao Stefano, infatti ho visto che 76+4 non lo rileva ora controllo perche.

    vedo anche di cambiare il colore alla ruota.

    però non ho capito questo


    Poi secondo Te quel tipo di ricerca riesco a farla modificandola solo se il terno è su una singola ruota, ad esempio se su Torino trova il 90 con i numeri 65 e 25 in ogni posizione ma stessa ruota o per excel stessa riga.



    un saluto Ciao By Sal [SM=x423051]

    [Modificato da by sal 19/03/2020 07:08]
    se ti piace la soluzione sostienici con una DONAZIONE a piacere. Grazie clicca qui
  • OFFLINE
    by sal
    Post: 5.854
    Registrato il: 14/11/2004
    Utente Master
    Office 2019
    00 19/03/2020 07:45
    somma terni
    Ciao ecco la modifica, ho risolto anche il problema dell'80

    Sub sommaT()
    Dim r, r1, c, c1, x, y, k, d, n, t, rng
    
    Set rng = Range("E8:I18")
    Range("E8:I18").Interior.Color = RGB(198, 224, 180)
    Range("D8:D18").Font.Color = RGB(0, 0, 0)
    n = Cells(6, 11)
    r1 = 8
    c1 = 5
    t = 0
    For Each k In rng
        If k = n Then
            r = k.Row: c = k.Column: t = 1
            Cells(r, c).Interior.Color = RGB(255, 255, 0)
            If t = 1 Then
                For y = 5 To 9
                    d = Cells(r, y)
                If d = n Then GoTo 1
                    For x = r1 To r1 + 10
                        If x = r Then GoTo 2
                        If Cells(x, y) = n Then GoTo 2
                        If d = 6 Then
                            d = d
                        End If
                        If d + Cells(x, y) = n Then
                            Cells(x, y).Interior.Color = RGB(0, 176, 240)
                            Cells(x, 4).Font.Color = RGB(255, 0, 0)
                            Cells(r, y).Interior.Color = RGB(0, 176, 240)
                            Cells(r, 4).Font.Color = RGB(255, 0, 0)
                            n = n
                        End If
    2                Next x
               Next y
               t = 0
            End If
        End If
    Next k
    End Sub


    fai copia incolla della macro

    Ciao By Sal [SM=x423051]

    se ti piace la soluzione sostienici con una DONAZIONE a piacere. Grazie clicca qui
  • OFFLINE
    Xeroxs64
    Post: 84
    Registrato il: 20/01/2020
    Età: 60
    Utente Junior
    2016
    00 19/03/2020 07:52
    Ciao, Grazie

    Praticamente quella ricerca di somma deve essere fatta solo in orizzontale e su ruota. Ti ho modificato il file che riallego modificato per comprendere il senso.

    Grazie.
  • OFFLINE
    Xeroxs64
    Post: 85
    Registrato il: 20/01/2020
    Età: 60
    Utente Junior
    2016
    00 19/03/2020 07:55
    Ciao,

    Ho testato la modifica ma mi da errore

    If d = n Then GoTo 1

    sul GoTo 1

  • OFFLINE
    by sal
    Post: 5.856
    Registrato il: 14/11/2004
    Utente Master
    Office 2019
    00 19/03/2020 09:24
    somma terni
    Ciao Per l'errore, alla macro, alla riga 32 sotto il 2 metti 1, tutto qui.
    mi sono dimenticato di reinserirlo.

    tu vuoi lo stesso discorso in orizzontale, ma logicamente solo sulla riga del numero oppure si tutte le righe(ruote).

    fai sapere, Ciao By Sal [SM=x423051]

    se ti piace la soluzione sostienici con una DONAZIONE a piacere. Grazie clicca qui
  • OFFLINE
    Xeroxs64
    Post: 86
    Registrato il: 20/01/2020
    Età: 60
    Utente Junior
    2016
    00 19/03/2020 09:52
    la modifica se si può su tutte le righe purchè terno di somma.

    Scusa il ritardo per la risposta.
    Grazie.
  • OFFLINE
    Xeroxs64
    Post: 87
    Registrato il: 20/01/2020
    Età: 60
    Utente Junior
    2016
    00 19/03/2020 10:06
    Ciao, ho fatto la modifica inserendo il 2

    così
    n = n
    End If
    2 Next x
    1 Next y
    t = 0
    End If
    End If
    Next k
    End Sub

    ma non evidenzia dove sbaglio?
  • OFFLINE
    Xeroxs64
    Post: 88
    Registrato il: 20/01/2020
    Età: 60
    Utente Junior
    2016
    00 19/03/2020 10:08
    mannaggia non la scrive come dovrebbe, spero che Tu capisca dove è il mio errore...
  • OFFLINE
    by sal
    Post: 5.858
    Registrato il: 14/11/2004
    Utente Master
    Office 2019
    00 19/03/2020 11:21
    somma terni
    Ciao ecco il file, con i 2 sistemi vedi se ho capito bene, quando inserisci il numero da cercare in automatico parte la ricerca in verticale, mentre per quella orizzontale premi il secondo "Vai"

    fai sapere, Ciao By Sal [SM=x423051]

    se ti piace la soluzione sostienici con una DONAZIONE a piacere. Grazie clicca qui
  • OFFLINE
    Xeroxs64
    Post: 89
    Registrato il: 20/01/2020
    Età: 60
    Utente Junior
    2016
    00 19/03/2020 11:55
    Ciao, grazie

    per quella orizzontale ti ho creato un immaggine di eesmpio con la somma 90 quella di Firenze se si può non deve essere evidenziata in qunto non è un terno di somma "orizzontale, spero di averti fatto capire e scusa se io non sono stato chiaro, perchè a volte pensi di esserlo eti ringrazio soprattutto per la pazienza.
  • OFFLINE
    by sal
    Post: 5.859
    Registrato il: 14/11/2004
    Utente Master
    Office 2019
    00 19/03/2020 14:54
    somma terni
    Ciao ecco la modifica della macro

    Sub sommaO()
    Dim r, r1, c, c1, x, y, k, k0, k1, d, n, t, rng
    
    Set rng = Range("E8:I18")
    Range("E8:I18").Interior.Color = RGB(198, 224, 180)
    Range("D8:D18").Font.Color = RGB(0, 0, 0)
    n = Cells(6, 11)
    r1 = 8
    c1 = 5
    t = 0
    For Each k In rng
        If k = n Then
            r = k.Row: c = k.Column: t = 1
            Cells(r, c).Interior.Color = RGB(255, 255, 0)
            If t = 1 Then
                For x = 8 To 18
                    For y = 5 To 8
                        For k0 = y + 1 To 9
                            If Cells(x, y) = n Then GoTo 2
                            k1 = Cells(x, y) + Cells(x, k0)
                            If Cells(x, y) + Cells(x, k0) = n And x = r Then
                                Cells(x, y).Interior.Color = RGB(0, 176, 240)
                                Cells(x, 4).Font.Color = RGB(255, 0, 0)
                                Cells(x, k0).Interior.Color = RGB(0, 176, 240)
                            End If
                        Next k0
    2                Next y
    1            Next x
               t = 0
            End If
        End If
    Next k
    End Sub


    si doveva solo mettere un filtro alla ricerca, alla riga 21 questo

    If Cells(x, y) + Cells(x, k0) = n And x = r Then

    Ciao By Sal [SM=x423051]

    [Modificato da by sal 19/03/2020 14:55]
    se ti piace la soluzione sostienici con una DONAZIONE a piacere. Grazie clicca qui
  • OFFLINE
    Xeroxs64
    Post: 90
    Registrato il: 20/01/2020
    Età: 60
    Utente Junior
    2016
    00 19/03/2020 15:25
    wow, Grazie ancora.