Aumenta/dim la parte numerale di un intervallo di formule

[papiriof]

Buonasera, parliamo di fi macro excel : Ho un intervallo BH3:BJ21 in ogni cella ci sono delle formule tipo: =pip($G13+un), =pip($H13+du), =pip($F13+tr) poi la seconda riga =pip($G26+un),=pip($G26+du),, =pip($G26+tr) . etc etc A me servirebbe una macro che cambiasse tutti insieme esclusivamente i NUMERI contenuti nelle formule che potrei controllare con una user form avanti e indietro +1,2,3...10 oppure -1,2,3.....10 cosi le 6 formule sarebbero idendiche ma invece di 13 ci sarebbe 14 e per le seconte invece 27 al posto di 26 .questo se avvessi scelto di aumentare il tutto di 1. Potrei usare Trova e Sostituisci ma lo dovrei fare per 18 volte, ci sarebbe un'altra via?

[Anthony47]

E' possibile vedere le vere formule? Vorrei evitare di fare una cosa triviale e valutare invece una soluzione piu' tecnica

[papiriof]

https://i.postimg.cc/0QFy769B/xAnthony.jpg

[papiriof]

Alcune spiegazioni in BH1,BI1e BJ1 ci sono tre numeri "nominati" un,du,tr questi tre numeri (da 1 a90)vengono mescolati velocemente
con la macro vedi bottone "fino A" e si ferma quando il risultato auspicato (in BC1 =18)Inquesta simulazione analizzo la ruota di VEnezia
e la macro si ferma perchè in AX1 ha raggiunto 18 risultati utili ovvero ogni ultima estrazione mensile prendiamo tre numeri(qui G13,H13 e F13 rispettivamente 4° 5° e 3° del 30/11/21 di BARI nella fattispecie 54,19 e 85 che aggiunti a " un,du,tr "col fuori 90 da i tre numeri 31 24 e 15 che ipoteticamente pongono in gioco nelle 6 estrazioni successive si veda per es. CO3 come viene rilevata l'uscita del 15 , la Funzione pip è di Anthony di seguito funzione e macro'

Codice: Seleziona tutto

Function pip(ByVal Val As Long, Optional ByVal limite As Long = 90) 'SSSSSSSSSSSSSSSSSIIIIIIIIIIIIII
    If Val < 0 Then Val = Val + limite
    pip = Val Mod limite
    If pip = 0 Then pip = limite   
End Function

Codice: Seleziona tutto

Public Sub Propo3()
    Application.ScreenUpdating = False
    Dim numeri(1 To 3) As Long
    Dim a As Long
    Dim b As Long
    Dim n As Integer
    Dim arr(1 To 90) As Long
    Dim temp As Long
   
    Randomize ' IMPORTANTE
    mytim = Timer
    Do
        Application.ScreenUpdating = False
        doCnt = doCnt + 1
        ' riempie l'array con numeri da 1 a 90
        For a = 1 To 90
            arr(a) = a
        Next a
        ' mescola l'array
        For a = 1 To 90
            b = Int(Rnd * 90) + 1
            temp = arr(a)
            arr(a) = arr(b)
            arr(b) = temp
        Next a
        ' prende i primi 3 numeri dell'array mescolato
        For a = 1 To 3
            numeri(a) = arr(a)
        Next a
       
        Range("bh1:bj1") = numeri
On Error Resume Next
        If Cells(1, 55) <= Cells(1, 50) Then Exit Do  'SE LA CELLA RIGA 1 COLONNA 55E' <= ALLA CELLA RIGA 1 COLONNA 50 ESCE DALLA MACRO
 
    Loop
    Application.ScreenUpdating = True
    Debug.Print Format(Timer - mytim, "0.00"), doCnt, Format((Timer - mytim) / doCnt, "0.000")
    Beep
    Application.ScreenUpdating = True
   
End Sub

[papiriof]

tutto il file è diciamo "RIGIDO" in quanto è impostato tutto con numeri presi null'ultima estrazione con inizio gioco dala prima estrazione del mese per 6 estrazioni. Ma se si prendono inumeri alla 3^ del mese con inizio gioco alla 4^?

[Anthony47]

Per quanto riguarda la modifica delle formule, sperando di aver afferrato:
-inserisci in una cella l'incremento +/- che vuoi applicare; io ho usato P1
-Poi usa questa macro:

Codice: Seleziona tutto

Sub Reformula()
Dim myC As Range, myF As String, Incr As Integer
'
Incr = Range("P1").Value                '<<< La cella con l'incremento (+/-) voluto
For Each myC In Range("H4:J12")         '<<< L'area da modificare
    If myC.HasFormula Then
        myF = myC.FormulaLocal
        myC.FormulaLocal = Replace(myF, myC.Precedents.Row, myC.Precedents.Row + Incr, , , vbTextCompare)
        Debug.Print myF, myC.Formula
    End If
Next myC
Debug.Print ">>"
End Sub


Le due righe marcate <<< vanno modificate per adattarsi al tuo ambiente

Quanto alla domanda "Ma se si prendono inumeri alla 3^ del mese con inizio gioco alla 4^?" purtroppo non mi e' chiara quindi non so che suggerire

[papiriof]

Grazie Anthony la macro da me modificata (come suggerito)in questa maniera:
Sub Reformula()
Dim myC As Range, myF As String, Incr As Integer
'
Incr = Range("be1").Value '<<< La cella con l'incremento (+/-) voluto
For Each myC In Range("bH3:bj20") '<<< L'area da modificare
If myC.HasFormula Then
myF = myC.FormulaLocal
myC.FormulaLocal = Replace(myF, myC.Precedents.Row, myC.Precedents.Row + Incr, , , vbTextCompare)
Debug.Print myF, myC.Formula
End If
Next myC
Debug.Print ">>"
End Sub
Dunque dicevo cosi modificata funziona , ma (colpa mia) non ho fatto notare che l'area da modificare è piu vasta
scusa ma sono costretto ad intterromper.... continuo dopo

[papiriof]

continuo..... dicevo che l'area in cui i numeri delle formule dovrebbero cambiare sarebbe anche BL3:CO20 . Per capire si tenga presente
l'immagine mandata e tenendo presente che sotto esame è la ruota di VEnezia adesso nelle celle CM3,CN3 e CO3 ci sono di seguito le formule CONTA.SE(AW14:BA19;BH3),CONTA.SE(AW14:BA19;BI3 ) e CONTA.SE(AW14:BA19;BJ3). Dove qualora avessi dato corso alla prima macro "Reformula" e avessi messo +1in una nuova macroda fare mi aspetterei CONTA.SE(AW15:BA20;BH3),CONTA.SE(AW15:BA20;BI3 ) e CONTA.SE(AW15:BA20;BJ3 per armonizzare conseguentemente quanto fatto dalla prima macro . non cambierebbe solo i BH3, BI3 e BJ3.

[Anthony47]

Non ho capito se qiello che dici a proposito delle formule in CM3,CN3 e CO3 e' un timore o una richiesta...
Prova a elencare le tipologie di formule che sono coinvolte e, per ognuna, indicare come vorresti che venissero modificate
Ciao

[papiriof]

continuo..... dicevo che l'area in cui i numeri delle formule dovrebbero cambiare sarebbe anche BL3:CO20 . Per capire si tenga presente
l'immagine mandata e tenendo presente che sotto esame è la ruota di VEnezia adesso nelle celle CM3,CN3 e CO3 ci sono di seguito le formule CONTA.SE(AW14:BA19;BH3),CONTA.SE(AW14:BA19;BI3 ) e CONTA.SE(AW14:BA19;BJ3). Dove qualora avessi dato corso alla prima macro "Reformula" e avessi messo +1in una nuova macroda fare mi aspetterei CONTA.SE(AW15:BA20;BH3),CONTA.SE([color=#BFBF00]AW15:BA20[/color];BI3 ) e CONTA.SE(AW15:BA20;BJ3 per armonizzare conseguentemente quanto fatto dalla prima macro . non cambierebbe solo i BH3, BI3 e BJ3.

IN VERDE come il cambiamento IN ROSSO rimane tale

[Anthony47]

Questa macro prende in considerazioni sia formule tipo "pip" che tipo "Conta.Se":

Codice: Seleziona tutto

Sub ReFormula2()
Dim cPred As String, cForm As String
Dim mySplit, myC As Range
'
Incr = Range("o1").Value                '<<< La cella con l'incremento (+/-) voluto
For Each myC In Range("g4:J10")         '<<< L'area da modificare
    If myC.HasFormula Then
        cPrec = myC.Precedents.Address
        cForm = myC.FormulaLocal
        If InStr(1, cForm, "pip(", vbTextCompare) > 0 Then
            myC.FormulaLocal = Replace(cForm, myC.Precedents.Row, myC.Precedents.Row + Incr, , , vbTextCompare)
            Debug.Print myC.Address(0, 0), cForm, " 1-->", myC.FormulaLocal
        ElseIf InStr(1, cForm, "conta.se", vbTextCompare) > 0 Then
            myC.Formula = Application.ConvertFormula(myC.Formula, xlA1, xlA1, xlAbsolute)
            cPrec = myC.Precedents.Address
            cForm = myC.FormulaLocal
           
            mySplit = Split(cPrec & ", ", ",", , vbTextCompare)
            myC.FormulaLocal = Replace(cForm, mySplit(0), Range(mySplit(0)).Offset(Incr, 0).Address, , , vbTextCompare)
            Debug.Print myC.Address(0, 0), cForm, " 2-->", myC.FormulaLocal
        Else
            Debug.Print myC.Address(0, 0), "????", cForm
        End If
    End If
Next myC
End Sub


Come vedi ogni caso ha una sua gestione, perchè non c'e' una gestione che va bene per tutte le stagioni

Quando hai possibilità e voglia fai un controllo anche tu, ma soprattutto ...vai tranquillo

[papiriof]

Grazie Anthony , non si capisce perchè fa tutto bene come da me auspicato sbaglia solo le prime tre colonne (in pratica la ruota di bari ) per il resto mettendo 1 in BE1 (l'incremento) e BH3:CN21 (TUTTA L'AREA DA MODIFICARE comprendente formule pip che CONTA.SE)dalla precedente immagine inviata ho tolto la colonna VUOTA BK che separava le col "pip" dall'inizio delle formule Conta.SE
perche pensavo che quella colonna vuota facsse in qualche modo male così adesso la col BK è l'inizio delle col con formula conta.se
questo è quanto cambiato:

Codice: Seleziona tutto

Sub ReFormula2()
Dim cPred As String, cForm As String
Dim mySplit, myC As Range
'
Incr = Range("be1").Value                '<<< La cella con l'incremento (+/-) voluto
For Each myC In Range("bh3:cn21")         '<<< L'area da modificare
    If myC.HasFormula Then
        cPrec = myC.Precedents.Address
        cForm = myC.FormulaLocal
        If InStr(1, cForm, "pip(", vbTextCompare) > 0 Then
            myC.FormulaLocal = Replace(cForm, myC.Precedents.Row, myC.Precedents.Row + Incr, , , vbTextCompare)
            Debug.Print myC.Address(0, 0), cForm, " 1-->", myC.FormulaLocal
        ElseIf InStr(1, cForm, "conta.se", vbTextCompare) > 0 Then
            myC.Formula = Application.ConvertFormula(myC.Formula, xlA1, xlA1, xlAbsolute)
            cPrec = myC.Precedents.Address
            cForm = myC.FormulaLocal
           
            mySplit = Split(cPrec & ", ", ",", , vbTextCompare)
            myC.FormulaLocal = Replace(cForm, mySplit(0), Range(mySplit(0)).Offset(Incr, 0).Address, , , vbTextCompare)
            Debug.Print myC.Address(0, 0), cForm, " 2-->", myC.FormulaLocal
        Else
            Debug.Print myC.Address(0, 0), "????", cForm
        End If
    End If
Next myC
End Sub

in pratica siamo al 97%

[Anthony47]

Io non ho il file di prova, dovresti dirmi qualcosa in piu' su che cosa fa e che cosa ti saresti aspettato...
Fai una prova limitando l'area solo a BH3:BQ5" (ma forse ora Cagliari finisce a BP?):
-chiudi excel e riaprilo
-modifica la macro per la sola area suddetta; esegui la macro
-a conclusione apri la "finestra Immediata" del vba: dal vba, premi Contr-g (oppure Menu /Visualizza /Finestra Immediata)
-copia tutto quello che trovi scritto nella finestra e incollalo nel prossimo messaggio
Sempre con calma e quando hai voglia...

[Anthony47]

Lavorando su un tuo file precedente ho potuto constatare che l'uso di Range.Precedents e' inaffidabile, perche' i "Precedents" vengono spesso inventati.
Ho optato quindi per l'esame testuale della formula arrivando al seguente codice:

Codice: Seleziona tutto

Sub ReFormula3()
Dim cForm As String, Incr As Long
Dim mySplit, myC As Range, kREF As String, Caso As Long
'
Incr = Range("be1").Value                '<<< La cella con l'incremento (+/-) voluto
For Each myC In Range("bh3:cn21")        '<<< L'area da modificare
    If myC.HasFormula Then
        cForm = myC.FormulaLocal
        If InStr(1, cForm, "pip(", vbTextCompare) > 0 Then
            Caso = 1
            kREF = GimmeRef(cForm, "(", "+")
        ElseIf InStr(1, cForm, "conta.se", vbTextCompare) > 0 Then
            Caso = 2
            kREF = GimmeRef(cForm, "se(", ";")
        Else
            Caso = 3
        End If
        If Caso < 3 And Len(kREF) > 1 Then
            myC.FormulaLocal = Replace(cForm, kREF, Range(kREF).Offset(1, 0).Address, , , vbTextCompare)
            Debug.Print myC.Address(0, 0), cForm, "Caso=" & Caso, myC.FormulaLocal
        Else
            Debug.Print myC.Address(0, 0), cForm, "Caso=" & Caso, "------"
        End If
    End If
Next myC
End Sub

Function GimmeRef(ByVal lForm As String, ByVal iStr As String, ByVal eStr As String) As String
Dim iPos As Long, ePos As Long
'
iPos = InStr(1, lForm, iStr, vbTextCompare)
ePos = InStr(1, lForm, eStr, vbTextCompare)
If (iPos * ePos) > 0 Then
    GimmeRef = Mid(lForm, iPos + Len(iStr), ePos - iPos - Len(iStr))
End If
End Function


"A occhio" i risultati mi sembrano corretti, prova anche tu...

[papiriof]

Grazie Anthony ho provato, vabene ma....... nella cella con l'incremento (+/-) voluto BE1 funziona solo in positivo per cui se metto 1 tutta la faccenda dei riferimenti giustamente aumenta di 1 ma se dopo voglio ritornare indietro mettenndo -1 va ancora avanti di uno è come se ignorasse il "-" .
Inoltre essendo le estrazioni di mese in mese diverse (ci sono mesi con minimo 12 e massimo 14 estrazioni) sarebbe opportuno considerare questo inconveniente e mettere una user form per mettere che richieda dache data (estrazione) decorrono le sei estrazioni da porre in esame.

[Anthony47]

vabene ma....... nella cella con l'incremento (+/-) voluto BE1 funziona solo in positivo per cui se metto 1 tutta la faccenda dei riferimenti giustamente aumenta di 1 ma se dopo voglio ritornare indietro mettenndo -1 va ancora avanti di uno è come se ignorasse il "-"

E ci credo che fa sempre +1: ho sbagliato io
Nell’istruzione

Codice: Seleziona tutto

myC.FormulaLocal = Replace(cForm, kREF, Range(kREF).Offset(1, 0).Address, , , vbTextCompare)

quell’ Offset(1,0) va modificato in Offset(Incr,0)

Inoltre essendo le estrazioni di mese in mese diverse (ci sono mesi con minimo 12 e massimo 14 estrazioni) sarebbe opportuno considerare questo inconveniente e mettere una user form per mettere che richieda da che data (estrazione) decorrono le sei estrazioni da porre in esame

Questa non la so interpretare, prova a spiegare in che modo c’entra con quello che abbiamo fatto

[papiriof]

Grazie Anthony, adesso funge per l'altra parte non inporta so gestire bene la cosa anche così .
Piuttosto mi interesserebbe sviluppare uuna formula, mi spiego : Attualmente in CS3 ho questa formula =SE(SOMMA(BK3:BM3)>0;1;0) essa se è = ad 1 significa che è uscito almeno un numero di quelli 3 indicati in BK3:BM3 nelle 6 righe in sottostanti ((in questo caso Bari).
Tutto questo per rilevare se c'è almeno un estratto e allora , domanda come dovrebbe esse scritta la formula =SE(SOMMA(BK3:BM3)>0;1;0) per trovare un ambo? nella formula =SE(SOMMA(BK3:BM3)>0;1;0) non importa dove escono e quanti ne escono ma per trovare un ambo due di quei numeri devono uscire nella stessa riga.

[Anthony47]

Le formule in CS3 e successive guardano a un blocco di estrazioni, non una singola.
se vuoi contare quanti numeri di un elenco (es i tre numeri in BH1:BJ1) sono presenti in una singola estrazione devi usare una formula del tipo
=Somma(Conta.se(Estrazione;MieiNumeri)

Esempio

Codice: Seleziona tutto

=SOMMA(CONTA.SE(D3:H3;BH1:BJ1))

Da confermare con Contr-Maiusc-Enter; un ambo corrisponde al risultato "2"

[papiriof]

Le formule in CS3 e successive guardano a un blocco di estrazioni, non una singola.
se vuoi contare quanti numeri di un elenco (es i tre numeri in BH1:BJ1) sono presenti in una singola estrazione devi usare una formula del tipo
=Somma(Conta.se(Estrazione;MieiNumeri)

Esempio

Codice: Seleziona tutto

=SOMMA(CONTA.SE(D3:H3;BH1:BJ1))

Da confermare con Contr-Maiusc-Enter; un ambo corrisponde al risultato "2"

No , non voglio contare se in una riga è uscito un ambo formato da i num indicati in BH1:BJ1 ma in quelli indicati in BH3:BJ3 inoltre l'intervallo dove cercarli non è D3:H3 ma è D14:H19 in definitiva la formula dovrebbe essere SOMMA(CONTA.SE(D14:H19;BH3:BJ3)) ancorchè confermato con Contr-Maiusc-Enter

[papiriof]

..... ma la formula sopra non funziona