Applicare Metodo Piramide In Colonna

[ikwae]

Ciao a tutti … vorrei costruire un nuovo filtro per il mio programma e ho pensato al
filtro con il metodo a piramide. Sono riuscito a fare una macro casareccia chilometrica
l’indicatore del VBA indica 977 righe e riesco solo a fare solo la prima riga figurati quanto
ne servono per la seconda o arrivare in fondo alla colonna.

Quindi chiedo aiuto a tutto il Form per avere, se possibile, una macro con i seguenti passi:

1a) I riferimenti sono da ActiveCell e le sei celle a sinistra. Non ci sono altri riferimenti.

2b) ActiveCell non si sa da dove inizia ma sicuramente è sulla prima riga.

3c) Alle sei celle a sinistra di ActiveCell applicare la prima regola ossia aggiungere il 9
alle celle che abbiano i numeretti (1 al 9) meglio dire controllare le sei celle a sinistra
e, dove c’è il numero a una cifra, aggiungere il 9 (non serve colorare le celle di giallo)

Esempio_1 sestina 13 2 35 77 18 90 diventa 13 92 35 77 18 90
Esempio_2 sestina 4 45 2 8 33 1 diventa 94 45 92 98 33 91
Esempio_3 sestina 1 2 3 4 5 6 diventa 91 92 93 94 95 96

4d) contare le righe della colonna
5e) calcolare la piramide sulla riga applicando la seconda regola del fuori 9.
Se chi mi aiuta conosce le regole della piramide molto meglio altrimenti
non do per scontato che si sappiano le regole della piramide e, pertanto,
sul foglio dell’allegato “Piramide_Calcolo” c’è il calcolo dettagliatissimo
della piramide applicata alla sestina riportata sul foglio “aMaster” Range(“G7:L7”).

6f) Scrivere in ActiveCell solo i numeri terminali della piramide con la regola del fuori 90.
Esempio_1 se il calcolo della piramide finisce con i numeri 91 si calcola 91-90=1
Esempio_2 se il calcolo della piramide finisce con i numeri 97 si calcola 97-90=7

Oppure molto più semplice (avere un unico criterio) continuare la piramide
con 9+1=10-9=1 (regola del fuori 9)
con 9+7=16-9=7 (regola del fuori 9)
scegliere il più facile tanto il risultato non cambia.

7g) applicare su tutte le righe, precedentemente contate, il punto 6f).
8h) la macro di aiuto dovrebbe essere autonoma ossia senza interventi esterni ma richiamata da altre macro.

Ricapitolando:
_prendere in esame le sei celle a sinistra di ActiveCell (che non si sa in che posizione della prima riga sia)
_aggiungere dove è necessario il numero 9
_contare le righe
_scrivere in AcriveCell il risultato finale della piramide
_continuare su tutte le righe della colonna.
_autonomia della macro verrà richiamata da altre macro

In allegato un file con tre fogli:
Foglio “Piramide_Calcolo” c’è scritto la sequenza passo-passo di una sestina con regole.

Foglio “Deposito” dove sono riportate solo cinque diversi scenari con delle righe, poche
o tante, che il programma può generare. Aggiungo ogni scenario ha le prime dieci righe
con celle colorare di giallo ad indicare dove è stato aggiunto il 9 ai numeri ad una cifra.
E a fine riga solo il risultato della piramide (delle sei celle a sinistra).

Foglio “aMaster” vuoto per non dare false indicazioni su AcriveCell quindi caricare
uno scenario a piacere sul foglio e mandare in esecuzione la macro di aiuto
che, spero, mi venga concessa e dovrebbe dare lo stesso risultato di ogni fine
riga già calcolata. Naturalmente deve arrivare fino alla fine delle righe.

Ringraziando anticipatamente tutti coloro che mi possono aiutare 73 ikwae

https://we.tl/t-0zegycPyf5
****************************
Per confrontare la mia chilometrica macro casareccia ho perso tantissimo tempo a
trovare in rete qualche piramide (con 6 celle separate) di sestina completa ma è stata
una ricerca vana.
Quindi sul foglio “Piramide_Calcolo” sulla parte destra ci sono delle sestine
con il calcolo della piramide completa di tutte le righe e il risultato finale in coda.
In giallo, le celle, che la macro ha aggiunto il numero 9.
Spero che sia cosa utile.

[Francesco53]

Ciao ti metto la macro io ho utilizzato le 20 righe del foglio Scenario.
La macro conta il numero di righe su cui fare la piramidazione, e il risultato per ogni riga lo scrive nella colonna M.
Tu naturalmente devi adattare alle tue esigenze i riferimenti di ricerca.
Ti ho bloccato il calcolo automatico ('Application.Calculation = xlCalculationManual) però dopo che hai provato le tue ventine di righe, se devi fare il calcolo su tantissime righe ti conviene abilitarlo.

Codice: Seleziona tutto

Sub Cerca()
Dim nr(6)
Worksheets("Scenario").Select
Application.ScreenUpdating = False
'Application.Calculation = xlCalculationManual
fin = Range("G" & Rows.Count).End(xlUp).Row
    For rig = 1 To fin
    conta = 0
        For col = 7 To 12
        conta = conta + 1
        If Cells(rig, col) < 10 Then
            nr(conta) = 90 + Cells(rig, col)
            Else
            nr(conta) = Cells(rig, col)
        End If
        Next col
        Cells(rig, 13) = Piramida(nr(1), nr(2), nr(3), nr(4), nr(5), nr(6))
    Next rig
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Function Piramida(n1, Optional n2, Optional n3, Optional n4, Optional n5, Optional n6)
    Dim Vet_Numeri(6): Dim Vet_Cifre(12)
    Vet_Numeri(1) = n1: Vet_Numeri(2) = n2: Vet_Numeri(3) = n3: Vet_Numeri(4) = n4: Vet_Numeri(5) = n5: Vet_Numeri(6) = n6
    conta = 0
    For K = 1 To 6
       If Not IsMissing(Vet_Numeri(K)) Then
         Select Case Vet_Numeri(K)
            Case 0: conta = conta
            Case 10 To 99
                    conta = conta + 1
                    Vet_Cifre(conta) = Left(Vet_Numeri(K), 1)
                    conta = conta + 1
                    Vet_Cifre(conta) = Right(Vet_Numeri(K), 1)
         End Select
       End If
    Next K
    If conta = 0 Then Piramida = 0
    If conta = 1 Then Piramida = Vet_Cifre(conta)
    If conta > 1 Then
        Num_linee_pir = conta - 1
        ReDim Vet_linee(Num_linee_pir, conta)
        For K = 1 To conta
           Vet_linee(Num_linee_pir, K) = Vet_Cifre(K)
        Next K
        For Linea = Num_linee_pir - 1 To 1 Step -1
           For num = 1 To Linea + 1
             Vet_linee(Linea, num) = (Vet_linee(Linea + 1, num) + Vet_linee(Linea + 1, num + 1)) Mod 9
           Next num
        Next Linea
        Piramida = (Vet_linee(1, 1) * 10 + Vet_linee(1, 2)) Mod 90
        If Piramida = 0 Then Piramida = 90
     End If
End Function

Ciao
Francesco

[ikwae]

Gentilissimo Francesco… innanzitutto buona domenica e ti leggo sempre sui post
quando sono in giro sulla rete per cercare delle indicazioni e, leggendo cosa scrivi,
ti stimo molto.
Ti ringrazio della macro di aiuto che hai scritto ma sono molto addolorato perché
non la posso usarla perché ha un range statico mentre dovrebbe essere come da richiesta.

@ikwae ha scritto
1a) I riferimenti sono da ActiveCell e le sei celle a sinistra. Non ci sono altri riferimenti.

E per evitare equivoci ho aggiunto

@ikwae ha scritto
Foglio “aMaster” vuoto per non dare false indicazioni su AcriveCell quindi caricare
uno scenario a piacere sul foglio e mandare in esecuzione la macro di aiuto….

Purtroppo qualche cosa devo allegare per dare indicazioni sui risultati alle righe della piramide
e delle regole da seguire. Sicuramente qui è nato l’ingannevole e involontario equivoco.

La tua macro, certamente, non andrà sprecata perché in rete, nelle mie ricerche, non ne ho trovate come la tua.
Credimi sono veramente dispiaciuto per il tempo che hai usato per la macro che io non posso (per il momento) usare.
Cordialmente ikwae

[Anthony47]

Personalmente sono in viaggio, mi e' impossibile esaminare la questione prima di 36 ore; vediamo se qualcun altro se la sente

[Francesco53]

Un saluto a tutti, ciao Anthony,
Ikwae prima di inviarti la nuova macro ho bisogno di capire se ho fatto la modifica giusta.
foglio Scenario, ti posizioni nella cella M9, avvii la macro e ti scrive il risultato della Piramidazione,
è questo che vuoi? altrimenti non riesco a capire quale sia la tua esigenza.
La prima macro ti calcolava per ogni riga la piramidazione, questa per la singola riga dove è posizionato il cursore.
Fammi sapere,
Francesco

[ikwae]

@ Anthony
Gentilissimo come sempre … è solo un hobby e, classificato come "fidato utente",
attendo fiducioso fai buon viaggio.

@ Francesco
Ciao .. intanto che aspettavo qualche risposta ho collaudato la tua macro, come giusto
che sia per rispetto del tuo lavoro e sia per rispetto al post quindi ti allego il foglio del
mio collaudo sulla colonna M il risultato della tua macro e sulla colonna N il risultato
della mia macro chilometrica casareccia aggiungo pasticciona.
Sulla parte destra del foglio l’integrale delle prime 15 sestine con tutte le righe che
necessitano alla piramide.

Come ho scritto su ma mia macro è chilometrica con 977 righe e probabilmente
dato che sono state scritte tutte a mano probabilmente c’è qualche errore.

Cerca di capire quale colonna sia giusta e, se necessario, vedremo poi il da farsi.

Comunque io la tua macro non la posso usare come al precedente post ho motivato
In più dopo il collaudo, ho notato che è carente del punto 3c) della mia richiesta
descritta con tre esempi ossia di aggiungere il 9 a tutti i numeri che hanno una sola cifra.

Pertanto, con il tuo permesso, facciamo un passettino alla volta poi se necessario andiamo avanti.
Ringraziandoti ulteriormente per il tuo gradito impegno cordialmente ikwae
https://we.tl/t-fCCce8fEna

[Francesco53]

Ciao rispondo subito alla tua osservazione sul punto 3c.
Il 9 davanti ai numeri ad una cifra, lo aggiunge direttamente la macro nel calcolo:

Codice: Seleziona tutto

If Cells(rig, col) < 10 Then
            nr(conta) = 90 + Cells(rig, col)
            Else
            nr(conta) = Cells(rig, col)
        End If

Controllerò il tuo nuovo file,
francesco

[Francesco53]

Ciao trovato l'errore dovuto al Mod 9 che restituiva 0 come è giusto, ma non per i calcoli che vuoi tu.
Devi aggiungere alla macro una linea, ti posto il codice tu sostituisce l'intera parte nella macro:

Codice: Seleziona tutto

For num = 1 To Linea + 1
             Vet_linee(Linea, num) = (Vet_linee(Linea + 1, num) + Vet_linee(Linea + 1, num + 1)) Mod 9
             
             'La linea sotto devi aggiungerla alla macro Piramida
             If Vet_linee(Linea, num) = 0 Then Vet_linee(Linea, num) = 9
             
           Next num

Adesso la macro è perfetta, devi comunque rispondere alla domanda che ti avevo fatto:
Tu vuoi posizionarti in una qualsiasi cella della colonna M e poi lanciando la macro ti fa il calcolo dei 6 numeri sul lato sinistro?
è questo che intendi come dinamico o cosa.
francesco

[ikwae]

Ciao Francesco …
Per rispondere alla tua domanda la devo dividere in due risposte
distinte e separate.
Il mio programma, dopo aver interpellato diversi fattori genera un numero random
Da 21 a 525 che sono le somme dei numeri di ogni sestina scrivo alcuni esempi.
Esempio_1 random numero 21 carica solo una sestina (una riga e 6 colonne)
Esempio_2 random numero 110 carica 111.897 sestine (111.897 righe e 6 colonne)
Esempio_3 random numero 168 carica 1.002.668 sestine (1.002.668 righe e 6 colonne)
Esempio_4 random numero 214 carica 2.581.506 sestine (1.048.575 righe in 6 colonne più
La rimanenza in altrettante righe e colonne e siamo a 12 colonne
Facendo i conti senza le colonne aggiuntive per altri dati ma restiamo
Con numeri semplici.
Esempio_5 random numero 249 carica 3.677.261 sestine (1.048.575 righe in 6 colonne …
Esempio_6 random numero 282 carica 3.878.583 sestine (1.048.575 righe in 6 colonne …
Di questi esempi c’è ne sono 505!

Quindi finito il numero random e caricato le sestine sul foglio aMaster emergono
Le naturali domande: in che colonna siamo? Quante righe sono?

Quindi non potendo dare una precisa risposta mi sono inventato una macro
casareccia di nome LaCellaSelezionaSoloQuella che poi Anthony l’ha resa
una vera macro strutturalmente corretta rinominandola LaCellaSelezionaSoloQuella2.

Questa macro è “specializzata” nella ricerca dell’ultima colonna e si posiziona
nella giusta cella, della prima riga, dove iniziano i calcoli che chiameremo ActiveCell.

Quindi mi rispondo da solo alle domande che mi sono fatto sopra:
In che colonna siamo? Non me ne frega nulla perché con ActiveCell ho tutto quello che mi serve.
E per quanto riguarda le righe? Idem come sopra perché sapendo ActiveCell le posso contare.

Tutto fila liscio per altri filtri ma per il filtro a piramide riesco a fare solo la prima riga (sestina).

Quindi chiedo aiuto a tutto il forum con le seguenti domande

1a) I riferimenti sono da ActiveCell e le sei celle a sinistra. Non ci sono altri riferimenti.

2b) ActiveCell non si sa da dove inizia ma sicuramente è sulla prima riga.

3c) Alle sei celle a sinistra di ActiveCell applicare la prima regola ossia aggiungere il 9
alle celle che abbiano i numeretti (1 al 9) meglio dire controllare le sei celle a sinistra
e, dove c’è il numero a una cifra, aggiungere il 9 (non serve colorare le celle di giallo)

4d) contare le righe della colonna

6f) Scrivere in ActiveCell solo i numeri terminali della piramide con la regola del fuori 90.

7g) applicare su tutte le righe, precedentemente contate, il punto 6f).

Anche se non avessi scritto il tema le domande di richiesta di aiuto sono coerenti
con le regole del VBA altro non saprei aggiungere o rispondere a altre domande
perché non saprei cosa altro aggiungere o dire.
Cordialmente ikwae

[Francesco53]

Ciao tu scrivi:
Il mio programma, dopo aver interpellato diversi fattori genera un numero random
Da 21 a 525 che sono le somme dei numeri di ogni sestina scrivo alcuni esempi.
Esempio_1 random numero 21 carica solo una sestina (una riga e 6 colonne)
Esempio_2 random numero 110 carica 111.897 sestine (111.897 righe e 6 colonne)
Esempio_3 random numero 168 carica 1.002.668 sestine (1.002.668 righe e 6 colonne)
Esempio_4 random numero 214 carica 2.581.506 sestine (1.048.575 righe in 6 colonne più
La rimanenza in altrettante righe e colonne e siamo a 12 colonne

Se si presuppone che tu gestisci tutto questo, sei pure in grado di stabilire le colonne dove andare a scrivere le sestine.
Se sei in grado di fare questo, la macro che ti ho inviato, gestita nel modo giusto ti scriverà in tutte le righe di ogni sestina
la piramidazione.
Comunque quello che tu scrivi e cerchi, è nella tua mente, per poter far capire meglio
come agisce la tua macro, dovresti forse inserire un file con la tua macro ed allora si potrà capire cosa fare,
anche se la macro che ti ho inviato fa già quello che chiedi, devi solo gestirla in base alle tue necessità.
Francesco

[Anthony47]

Non ho la pazienza di lavorare sul codice di Francesco, che comunque ringrazio anche io per il suo intervento; quindi ti propongo questa:

Codice: Seleziona tutto

Sub PyraIKAll()
Dim wArr, oArr()
Dim myRan As Range, myArr(0 To 1) As String, myRow As String
Dim I As Long, J As Long, K As Long, cSum As Long, Dbg As Boolean
'
Dbg = False
wArr = Range(ActiveCell.Offset(0, -6), ActiveCell.Offset(0, -6).End(xlDown)).Resize(, 6).Value
ReDim oArr(1 To UBound(wArr), 1 To 1)
'
If Dbg Then Debug.Print ">>>>>>"
For K = 1 To UBound(wArr)
    myArr(J) = ""
    For I = 1 To 6
        myArr(J) = myArr(J) & Format(wArr(K, I), "00")
    Next I
    Do
    myRow = myArr(J)
        J = (J + 1) Mod 2
        myArr(J) = ""
        For I = 2 To Len(myRow)
            cSum = (CLng(Mid(myRow, I, 1)) + CLng(Mid(myRow, I - 1, 1))) Mod 9
            If cSum = 0 Then cSum = 9
            myArr(J) = myArr(J) & CStr(cSum)
        Next I
        If Dbg Then Debug.Print myArr(J)
        If Len(myArr(J)) < 2 Then Exit Do
        DoEvents
    Loop
    oArr(K, 1) = CLng(myArr(J))
Next K
ActiveCell.Resize(UBound(wArr), 1) = oArr
If Dbg Then Debug.Print UBound(wArr) & " <<<<"
End Sub


Ti anticipo che il risultato che io calcolo e’ diverso da quello che hai calcolato tu. Questo perche’ io mi fermo quando ho un risultato monocifra, e tu ti fermi con 2; per cui (lavorando con il pattern di Scenario-Colonne G:L) tu scrivi 12 e io calcolo 1+2=3; tu scrivi 85 e io calcolo 8+5=13=4; etc

Dopo aver messo il codice in un modulo standard del vba, si seleziona la prima colonna libera accanto alle estrazioni (es in M1, per il pattern di colonne G:L) e si lancia la Sub
I risultati verranno scritti in quella colonna

Non vengono fatti controlli sulla consistenza dei dati alla sinistra della selezione, ne’ che la colonna dei risultati sia libera, quindi controlla bene prima di eseguire...


D:\DDownloads\[byIKWAE_C30711_PIRAMIDE_Rete.xlsb]aMaster

[ikwae]

Gentilissimo Anthony sempre molto gentile a rispondermi….

La tua macro è dinamica parte da AcriveCell come da richiesta non aggiungo altro.
Per quanto riguarda il risultato della piramide effettivamente fa esattamente come dici
ossia i numeri finiscono a una cifra e confrontando con i numeri a due cifre i conti tornano.
Tuttavia c’è questo piccolissimo neo che se il risultato della piramide è per esempio
Il numero 18 e viene convertito in 9 oppure il numero 51 viene convertito in 6
purtroppo sono numeri diversi di conseguenza risultati diversi.

Se è una modifica semplice ti chiedo, con molta calma e se hai voglia, se puoi
fare in modo che la piramide finisca, dove è necessario a due cifre ossia minore o uguale a 90.
Se invece c’è da rifare la macro la tengo così come perché il grosso scoglio era che
partisse da ActiveCell.
Ringraziandoti mille e mille volte per la tua professionalità e per la tua immensa disponibilità.
Cordialmente ikwae

[Anthony47]

Se è una modifica semplice ti chiedo, con molta calma e se hai voglia, se puoi fare in modo che la piramide finisca, dove è necessario a due cifre ossia minore o uguale a 90.

E' difficile difficile, ma ci proviamo lo stesso con questa variante:

Codice: Seleziona tutto

Sub PyraIKAll()
Dim wArr, oArr()
Dim myRan As Range, myArr(0 To 1) As String, myRow As String
Dim I As Long, J As Long, K As Long, cSum As Long, Dbg As Boolean
'
Dbg = False
wArr = Range(ActiveCell.Offset(0, -6), ActiveCell.Offset(0, -6).End(xlDown)).Resize(, 6).Value
ReDim oArr(1 To UBound(wArr), 1 To 1)
'
If Dbg Then Debug.Print ">>>>>>"
For K = 1 To UBound(wArr)
    myArr(J) = ""
    For I = 1 To 6
        myArr(J) = myArr(J) & Format(wArr(K, I), "00")
    Next I
    Do
    myRow = myArr(J)
        J = (J + 1) Mod 2
        myArr(J) = ""
        For I = 2 To Len(myRow)
            cSum = (CLng(Mid(myRow, I, 1)) + CLng(Mid(myRow, I - 1, 1))) Mod 9
            If cSum = 0 Then cSum = 9
            myArr(J) = myArr(J) & CStr(cSum)
        Next I
        If Dbg Then Debug.Print myArr(J)
        If Len(myArr(J)) < 3 Then Exit Do
 '       DoEvents
    Loop
    oArr(K, 1) = CLng("0" & myArr(J)) Mod 90
Next K
ActiveCell.Resize(UBound(wArr), 1) = oArr
If Dbg Then Debug.Print UBound(wArr) & " <<<<"
End Sub

Fai sapere

[ikwae]

Ciao…
Hai fatto molto bene a postare l’intera macro altrimenti, pasticcione come sono,
sicuramente avrei sbagliato a fare le giuste modifiche (dal 2 al 3 e il cm sotto).

Ho collaudato la macro e confrontando le prime 10 sestine, di ogni blocco,
i conteggi sono rigorosamente giusti.

I Padri Fondatori, dello sviluppo dei numeri a piramide, dicono di aggiungere ai
numeretti (dall’1 al 9) lo 0(zero) o il 9 per avere la giusta piramidazione.

Udite_Udite nella macro di Anthony è “tutto compreso” non serve né lo 0 e neppure il 9.

Scrivere le sestine (quante righe volete) in qualsiasi parte del foglio,
partendo dalla prima riga, selezionate l’intera colonna a destra delle sestine e mandate in
esecuzione la seconda macro e, dopo un tot di tempo, arrivano i risultati della piramidazione.

Il tot di tempo è il seguente (almeno per il mio pc).
Fino a 70/80 mila righe e pressoché istantaneo
Con 100.000 righe meno di 4 secondi
Con 200.000 righe meno di 6 secondi
Con 500.000 righe poco meno di 20 secondi
Con 1.048.575 righe poco meno di 40 secondi

Non è una richiesta per velocizzare la macro va bene così.

Ringraziandoti per il “doppio” lavoro e per la tua immensa disponibilità cordialmente ikwae

[Anthony47]

Non è una richiesta per velocizzare la macro va bene così

...anche perche' quella che ho pubblicata è la versione piu' veloce tra quelle che ho sperimentato, di più non son capace

[ikwae]

Gentilissimo Anthony…
Ne sono sicuro è certo che hai fatto tanti sperimenti.

Ne approfitto per chiederti, naturalmente se hai tempo e voglia.
Quando vedo una macro che riporta matrici faccio sempre “l’autopsia”
per recuperare e catalogare parti di codice (utili per capire e poi applicarli)
e sono arrivato al rigo Format(wArr(K, I), "00")
so perfettamente cosa è il Format (almeno credo) so anche la parte prima della virgola.
la seconda parte (quella evidenziata in blu) uno zero come segnaposto di cifra va bene
ma due no non capisco come applicata per il contesto della stupenda macro che mi hai fatto.
Puoi darmi qualche indicazione?
Ringraziandoti anticipatamente ikwae

[Anthony47]

[..]sono arrivato al rigo Format(wArr(K, I), "00") [...]

In effetti avrei dovuto commentare prima due tue affermazioni:

I Padri Fondatori, dello sviluppo dei numeri a piramide, dicono di aggiungere ai
numeretti (dall’1 al 9) lo 0(zero) o il 9 per avere la giusta piramidazione.
Udite_Udite nella macro di Anthony è “tutto compreso” non serve né lo 0 e neppure il 9.

Ebbene l’istruzione Format(wArr(K, I), "00") serve a mettere lo “0” dove serve, perche’ trasforma il valore (esempio) 3 in “03” mentre crea una stringa con i 6 numeri iniziali da cui il ciclo Do /Loop parte per la piramidazione.

selezionate l’intera colonna a destra delle sestine e mandate in
esecuzione la seconda macro e, dopo un tot di tempo, arrivano i risultati della piramidazione.

Qui la precisazione e’ che basta selezionare la prima cella libera accanto all’elenco da “lavorare” e non l’intera colonna: nella maggior parte dei casi non succede niente di strano, ma in qualche circostanza marginale la macro potrebbe interpretare male il punto di partenza.

Ne approfitto per pubblicare una penultima revisione della macro, che dovrebbe avere un miglioramento di velocita’ dell’ordine del 25%

Codice: Seleziona tutto

Sub PyraIKAll2()
Dim wArr, oArr()
Dim myRan As Range, myArr(0 To 1) As String, myRow As String
Dim I As Long, J As Long, K As Long, cSum As Long, Dbg As Boolean
'
Dbg = False
myTim = Timer
wArr = Range(ActiveCell.Offset(0, -6), ActiveCell.Offset(0, -6).End(xlDown)).Resize(, 6).Value
ReDim oArr(1 To UBound(wArr), 1 To 1)
'
If Dbg Then Debug.Print "------>>>"
For K = 1 To UBound(wArr)
    myArr(J) = ""
    For I = 1 To 6
        myArr(J) = myArr(J) & Format(wArr(K, I), "00")
    Next I
    Do
    myRow = myArr(J)
        J = (J + 1) Mod 2
        myArr(J) = ""
        For I = 2 To Len(myRow) - 1
            cSum = (2 * CLng(Mid(myRow, I, 1)) + CLng(Mid(myRow, I - 1, 1)) + CLng(Mid(myRow, I + 1, 1))) Mod 9
            If cSum = 0 Then cSum = 9
            myArr(J) = myArr(J) & CStr(cSum)
        Next I
        If Dbg And K < 4 Then Debug.Print myArr(J)
        If Len(myArr(J)) < 3 Then Exit Do
 '       DoEvents
    Loop
    oArr(K, 1) = CLng("0" & myArr(J)) Mod 90
Next K
ActiveCell.Resize(UBound(wArr), 1) = oArr
Debug.Print "IKAll2", K, Format(Timer - myTim, "0.0")
If Dbg Then Debug.Print UBound(wArr) & " <<<<"
End Sub


[ikwae]

Gentilissimo Anthony…
Quando te scrivi qualche cosa, come sempre ho scritto, per me e Vangelo rilegato a Bibbia.
Quindi;
@ Anthony ha scritto
Dopo aver messo il codice in un modulo standard del vba, si seleziona la prima colonna libera
accanto alle estrazioni (es in M1, per il pattern di colonne G:L) e si lancia la Sub risultati
verranno scritti in quella colonna

@ ikwae ha scritto
…..selezionate l’intera colonna a destra delle sestine e mandate in esecuzione la
seconda macro e, dopo un tot di tempo, arrivano i risultati della piramidazione.

di conseguenza a queste indicazioni, ho iniziato ad assemblare le macro per il filtro
a piramide e la prima macro è stata appunto di selezionare tutta la colonna l’ultima.

Codice: Seleziona tutto

Sub Seleziona_Tutta_la_Colonna()
Dim Y As Long
   For Y = Columns.Count To 1 Step -1
        Set zona = Columns(Y)
        conta = Application.WorksheetFunction.CountA(zona)
        If conta > 0 Then
            If Y < Columns.Count Then
                Columns(Y + 1).Select
                 Exit Sub
            End If
        End If
    Next Y
End Sub

Questa macro seleziona l’ultima colonna indipendentemente dove si trovano i dati.
Per il collaudo scrivere su un foglio, dove vi pare, un numero o una lettera e mandare
in esecuzione la macro verrà selezionata tutta la colonna a destra di quel dato ovunque
si trova rispettando i limiti naturali di Ecel

Con questo piccolo malinteso il post si è arricchito di una macro che facilmente
si può modificare per la sola cella iniziale.

Collaudo new macro.
Effettivamente, come scrivi, selezionando solamente la prima cella della
prima riga Il calcolo della piramide viene ugualmente eseguito.

I numeri confrontati con gli altri sono rigorosamente giusti.

Ho aggiunto una ulteriore prova caricando 500.000 ottine e il risultato è giusto
poi ho eliminato la prima colonna a sinistra e sono diventate settine e il risultato
è giusto poi ho ancora eliminato la prima colonna a sinistra e sono diventate
sestine e il risultato è unanime nei tre casi.

Questa tipo di prova è importante per me per vedere se la macro “sconfina”
oltre la sesta colonna, naturalmente a sinistra.

tot di tempo:
i tempi di esecuzione e di elaborazione della macro sono vistosamente migliorati
già prima erano accettabili adesso è molto meglio.

Fino a 80/90 mila righe e pressoché istantaneo
Con 100.000 righe poco più di 3 secondi
Con 200.000 righe quasi 5 secondi
Con 500.000 righe poco più di 13 secondi
Con 1.048.575 righe poco meno di 30(27,50) secondi

Finendo, aggiungo, che se prima ero già contento adesso di più ma dato che devo
fare solo 505 gruppi di sondaggio per recuperare i dati e poi verrà accantonata
la gestione piramide e iniziano i calcoli con i gruppi quindi penso che basti e avanza fin qui.

Ne approfitto per pubblicare una penultima revisione della macro

Se leggo bene si presume che ci sia anche un’ultima macro ma non ti chiedo nulla io come ho scritto su sono super contento naturalmente poi vedi te.

Ringraziandoti per la tua professionalità e per la tua infinita disponibilità
un ringraziamento di vero cuore cordialmente ikwae

[Anthony47]

Ne approfitto per pubblicare una penultima revisione della macro

Se leggo bene si presume che ci sia anche un’ultima macro ma non ti chiedo nulla io come ho scritto su sono super contento naturalmente poi vedi te

No no, non c'è nessuna evoluzione in vista, io mi fermo sempre alla penultima versione...

[ikwae]

Gentilissimo Anthony…
A dire la verità ero molto attento e concentrato sul “tema” che ho scritto
e mi sfuggito il senso della tua penultima dato che non sono un programmatore.

E, quindi, era da scrivere; se non è un “protocollo” dei programmatori si deduce…. Ecc.

Quindi non c’è nessun protocollo da seguire ma è da interpretare come tue personali direttive.
Di conseguenza un passettino avanti di conoscenza della Persona che mi aiuta.
Cordialmente ikwae