Condividi:        

NUMERI UGUALI E CONSECUTIVI IN RANGE VARIABILE

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

NUMERI UGUALI E CONSECUTIVI IN RANGE VARIABILE

Postdi miko » 13/02/10 12:40

ciao a tutti,
torno a disturbarvi di nuovo perchè ho bisogno dei vostri suggerimenti per realizzare un nuovo progetto.
per spiegravi meglio il problema inserisco una immagine
Immagine
nelle colonne da B a K ho un range che aggiorno, e quindi aumenta di righe;
consideriamo la prima combinazione, riga 3 da B3 a k3;
cerchiamo in tutto il range quanti numeri uguali, alla combinazione presa in esame, sono contenute nelle altre combinazioni;
mettiamo a fianco della riga 3, sotto la colonna NUMERI UGUALI da M3 a W3, il numero corrispondente alla quantità di numeri uguali trovati:
0 = nessun numero
1 = 1 numero uguale
2 = 2 numeri uguali
3 = 3 numeri uguali
.....
10 =10 numeri uguali
sotto la colonna NUMERI CONSECUTIVI, da Y3 ad AI3, indichiamo quanti dei numeri uguali trovati sono consecutivi:
0 = nessun consecutivo
1 = numero singolo
2 = 2 numeri consecutivi, coppia
......
10 = 10 numeri consecutivi
poi passiamo alla seconda combinazione e ripetiamo lo stesso calcolo, inserendo i valori nella riga M4-W4 , e riga Y4-AI4 .
in pratica per ciascuna combinazione troviamo i numeri uguali, il loro numero e la loro consecutività, ma non calcoliamo la quantità totale di numeri uguali ma quante volte si ha un solo numero uguale, quante volte 2 numeri uguali e così via.
ho visto altri topic, ad esempio numeri consecutivi in winforlife, ma in questo si fa una analisi globale, mentre nel mio progetto si tratta di una analisi singola.
per affrontare il problema, dopo una vasta ricerca e lettura, ho pensato a varie soluzioni:
1) macro cerca,
2) macro conta.se, countif
3) colorare celle con uguale valore e poi contare
4) paragonare o confrontare righe
5) cerca in tabelle o array
...
ma ora ho una grande confusione e non so proprio come procedere.
vorrei sapere, secondo voi esperti, quale è il metodo migliore o più semplice per procedere e quindi dove devo indirizzare il mio studio.
spero di avervi descritto con chiarezza il problema.
grazie saluti
miko
windows 10 - office 2013
miko
Utente Senior
 
Post: 520
Iscritto il: 29/12/09 10:44

Sponsor
 

Re: NUMERI UGUALI E CONSECUTIVI IN RANGE VARIABILE

Postdi Flash30005 » 13/02/10 14:31

Spero che questa macro tolga un po' di confusione e risolva il tuo quesito
Codice: Seleziona tutto
Sub Trova()
UR = Range("B" & Rows.Count).End(xlUp).Row
Range("M3:AI" & UR).ClearContents
For R1 = 3 To UR
    For R2 = 3 To UR
        Conta = 0
        If R1 = R2 Then GoTo saltaR
        For C1 = 2 To 11
            If C1 <> M_C1 + 1 Then CCons = 1
            For C2 = 2 To 11
                If Cells(R1, C1).Value = Cells(R2, C2).Value Then
                    Conta = Conta + 1
                    If C1 = M_C1 + 1 Then CCons = CCons + 1
                    M_C1 = C1
                    GoTo saltaC
                End If
            Next C2
saltaC:
        Next C1
        Cells(R1, 13 + Conta).Value = Cells(R1, 13 + Conta).Value + 1
        Cells(R1, 25 + CCons).Value = Cells(R1, 25 + CCons).Value + 1
saltaR:
    Next R2
Next R1
End Sub

Dobbiamo chiarire, però, come calcolare i numeri consecutivi
provala e fai sapere
Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: NUMERI UGUALI E CONSECUTIVI IN RANGE VARIABILE

Postdi miko » 14/02/10 13:49

buongiorno e buona domenica a tutti.
grazie flash per avermi preparato il codice, che ovviamente funziona;
sto cercando di capire le varie linee, ma a quanto ho potuto notare non esegue il calcolo che vorrei.
ti spiego meglio il tipo di calcolo con tre sole combinazioni, che dispongo su diverse colonne solo per evidenziare i numeri uguali, ma in realta per ogni riga i numeri sono 10 e sul foglio sono disposte come nella figura del mio post precedente:
Immagine
confrontiamo le prime due combinazioni, e contiamo i numeri uguali:
sotto la colonna "NUMERI UGUALI", nella riga della prima combinazione avremo questa situazione,(inserisco il simbolo X per il caso generale ed i numeri per il caso particolare che sto descrivendo):
0 = X , il valore X indica che sono uscite X combinazioni che non avevano numeri in
comune con la prima, quindi se X=0 la prima combinazione ha sempre avuto
numeri in comune con le altre uscite successivamente;
1 = X , il valore X indica che la prima combinazione ha avuto X volte 1 solo numero
uguale con le successive combinazioni
2 = X , il valore X indica che la prima combinazione ha avuto X volte 2 numeri
uguali con le successive combinazioni
3 = X , il valore X indica che la prima combinazione ha avuto X volte 3 numeri
uguali con le successive combinazioni
... =X
10 = X , il valore X indica che la prima combinazione ha avuto X volte 10 numeri
uguali con le successive combinazioni, cioè la prima combinazione si è
ripetuta, è uscita, più volte precisamente X volte.
quindi tra prima e seconda combinazione avremo:
6 numeri uguali :5-10-14-15-17-18
aggiorniamo la colonna "NUMERI UGUALI", sulla stessa riga della prima combinazione, come in figura:
Immagine
per quanto riguarda la consecutività:
0 = X , il valore X indica che X volte i numeri uguali trovati non sono mai stati
consecutivi, quindi se X è uguale a zero i numeri uguali sono stati sempre
consecutivi, si deve stabilire se coppie, terni etc.
1 = X , il valore X indica che tra i numeri uguali trovati ci sono X numeri singoli,
tipo 1-3 -5.., cioè non consecutivi
2 = X , il valore X indica che tra i numeri uguali trovati ci sono alcuni che formano una
coppia ed il numero di queste coppie è appunto X
3 = X , il valore X indica che tra i numeri uguali trovati ci sono alcuni che formano un
terno ed il numero di questi terni è appunto X
.... = X
10 = X , il valore X indica che i numeri uguali trovati sono tutti consecutivi e questa
situazione si è verificata X volte
sotto la colonna consecutivi avremo:
2 numeri singoli: 5-10
2 coppie:14-15 e 17-18
aggiorniamo la colonna "CONSECUTIVI", sulla stessa riga della prima combinazione, come in figura:
Immagine
finito il confronto tra prima e seconda combinazione passiamo ad esaminare sempre la prima combinazione ma con la terza:
i numeri uguali sono 6 : 1-4-10-16-17-20
4 numeri singoli:1- 4 -10- 20
1 coppia: 16-17
aggiorniamo la colonna numeri uguali, nella colonna dei 6 nella stessa cella della riga della prima combinazione aggiungiamo al precedente valore,6, quest'ultimo trovato, ancora 6, e quindi avremo un totale pari a 12;
Immagine
aggiorniamo la colonna dei numeri consecutivi, aggiungendo ai valori precedenti quest'ultimi trovati e quindi avremo :
0 = -
1 = 2 + 4 = 6
2 = 2 + 1 = 3
3= -
....
10 = -
Immagine
ripetiamo il calcolo per le altre combinazioni.
ho scritto un papiro ma non avevo altro modo per descrivere il problema, scusatemi, spero che la descrizione sia comprensibile.
grazie saluti
miko
windows 10 - office 2013
miko
Utente Senior
 
Post: 520
Iscritto il: 29/12/09 10:44

Re: NUMERI UGUALI E CONSECUTIVI IN RANGE VARIABILE

Postdi Flash30005 » 14/02/10 22:12

Ehmmm :roll:
E' la prima volta che mi capita di impostare una testata che definisca i gruppi di numeri (es. numeri uguali) e poi si imponga che non sia il numero di combinazioni avute relativamente a quel determinato gruppo ma si richiede la somma
se io ho nella testata da 1 a 10 (gruppi di numeri) e si verifica un gruppo da 6 dovrò mettere 1 sotto a 6 non 6 sotto a 6
1 2 3 4 5 6 7 8 9 10
0 0 0 0 0 1 0 0 0 0
al secondo passaggio in caso di 6 numeri ugulai avrò:
0 0 0 0 0 2 0 0 0 0
non
0 0 0 0 0 12 0 0 0 0

Comunque se ti occorre avere i valori in questa maniera non è un problema
è sufficiente che cambi la riga in fondo alla macro da
Codice: Seleziona tutto
        Next C1  '<<<< esistente
        Cells(R1, 13 + Conta).Value = Cells(R1, 13 + Conta).Value + 1  '<<< da cambiare come nel codice successivo

Codice: Seleziona tutto
        Next C1  '<<< esistente
        Cells(R1, 13 + Conta).Value = Cells(R1, 13 + Conta).Value + Conta

Ma ripeto, i dati così impostati, non sono nemmeno leggibili graficamente (prova a fare un grafico con asse x = testata e asse y i valori trovati).

Per quanto riguarda le consecutività potrebbe andare bene la stessa modifica ma devi testarla e verificare se ottieni ciò che desideri (le consecutività sono soggettive)
Codice: Seleziona tutto
        Cells(R1, 25 + CCons).Value = Cells(R1, 25 + CCons).Value + CCons


Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: NUMERI UGUALI E CONSECUTIVI IN RANGE VARIABILE

Postdi Flash30005 » 15/02/10 09:40

Ho dato uno sguardo allla macro consecutività e sembra che non sia proprio come dici
infatti il confronto tra la prima riga e la seconda porta a primo passagio
0 1 2 3 4 5 6 7 8 9 10
2 2
e al secondo passaggio altri
2 2
e non 4 numeri singoli e 1 doppio (1-4, 16-17)
quindi alla fine della terza riga avremo
0 1 2 3 4 5 6 7 8 9 10
4 4
e ho realizzato la macro che effettua questo conteggio, continuo comunque a non condividere il conteggio dei numeri uguali come da te esposto
Codice: Seleziona tutto
Sub TrovaU()
UR = Range("B" & Rows.Count).End(xlUp).Row
Range("M3:AI" & UR).ClearContents
For R1 = 3 To UR
    For R2 = 3 To UR
        Conta = 0
        If R1 = R2 Then GoTo saltaR
        For C1 = 2 To 11
            For C2 = 2 To 11
                If Cells(R1, C1).Value = Cells(R2, C2).Value Then
                    Conta = Conta + 1
                End If
            Next C2
saltaC:
        Next C1
        Cells(R1, 13 + Conta).Value = Cells(R1, 13 + Conta).Value + Conta
saltaR:
    Next R2
Next R1
Call TrovaC
End Sub
Sub TrovaC()
UR = Range("B" & Rows.Count).End(xlUp).Row
For R1 = 3 To UR
    For R2 = 3 To UR
        Conta = 0
        If R1 = R2 Then GoTo saltaR
        For C1 = 2 To 11
            CCons = 0
            TR = 0
            For C2 = 2 To 11
ciclo:
If C1 = 12 Or C2 = 12 Then GoTo SaltaE
                If Cells(R1, C1).Value = Cells(R2, C2).Value Then
                    CCons = CCons + 1
                    C1 = C1 + 1
                    C2 = C2 + 1
                    TR = 1
                    GoTo ciclo
                End If
SaltaE:
                If TR = 1 Then
                    Cells(R1, 25 + CCons).Value = (Cells(R1, 25 + CCons).Value + 1)
                    CCons = 0
                    C1 = C1 - 1
                    GoTo saltaC
                End If
            Next C2
saltaC:
        Next C1
saltaR:
    Next R2
Next R1
End Sub


Prova e fai sapere
Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: NUMERI UGUALI E CONSECUTIVI IN RANGE VARIABILE

Postdi miko » 15/02/10 13:07

ciao flash, buongiorno
hai proprio ragione a non condividere niente di quello che ho scritto nel mio precedente post, è tutto sbagliato.
ho descritto veramente male il problema, molta confusione;
neanche io avevo capito il vero calcolo che bisognava fare, scusami tanto.
ti ho fatto impegnare per niente, ma mi hai fornito dei buoni chiarimenti.
questo è dovuto anche al fatto che "vorrei" realizzare un calcolo che sia congruente con quello eseguito da un software, costoso e licenziato, che usano in un centro scommesse, io non posso prelevarlo per ovvii motivi.
hai ragione sul calcolo dei numeri uguali, e quindi il tuo primo codice è buono.
hai ragione anche sul calcolo della consecutività, è molto soggettiva, ed ora, analizzando una immagine del calcolo effettuato con questo software ho compreso la soggettività e forse, spero, il modo in cui questo software sviluppa i calcoli.
secondo la mia interpretazione, vedendo l'immagine che ti posto, e considerando sempre le 3 combinazioni del mio post precedente, sbagliato, confrontando la prima e seconda combinazione trova 6 numeri uguali: 5-10-14-15-17-18
Immagine
e fin qua il tuo primo codice va bene, poi mette 10 = 1, perchè considera tutta la prima combinazione, la confronta con le altre e verifica se ci sono combinazioni identiche;
se no pone 10 = 1, se si 10 = 2, 3 ...quante volte si è ripetuta la stessa combinazione;
per quanto riguarda la consecutività, non calcola, come io credevo, la somma del numero di coppie, terni etc.., ma la lunghezza della serie di numeri più lunga, così dei precedenti numeri uguali considera solo 14-15-17-18, lunghezza 4, e pone 4 = 1
ed ancora 10= 1, l'intera lunghezza della combinazione.
quando passa a confrontare la prima con la seconda trova ancora 6 numeri uguali, e come tu hai fatto giustamente, avremo 6= 2;
10=1 rimane invariato perchè non ci sono combinazioni uguali.
nella consecutività pone 2= 1, perchè tra i numeri uguali: 1-4-10-16-17-20
considera solo le due coppie,1-4 e 16-17, ma non fa la somma del numero di coppie, ma considera la lunghezza,2, della serie e pone consecutivi 2=1, cioè non conta quante coppie si trovano ma la lunghezza della serie;
se ad esempio si trovassero dei numeri uguali del tipo:
1-2-5-6-7
avremmo la coppia 1-2
il terno 5-6-7
ma lui considera la lunghezza più lunga delle due serie, e quindi avremmo solo
consecutività 3= 1.
spero questa volta di aver espresso con più chiarezza il tipo di calcolo.
scusami ancora per l'inconveniente, sono davvero rammaricato di creare disturbo e postare inutili richieste;
non sono poi tanto esperto in sistemistica.
grazie per la tua comprensione e disponibilità
ti auguro una piacevole giornata
saluti miko
windows 10 - office 2013
miko
Utente Senior
 
Post: 520
Iscritto il: 29/12/09 10:44

Re: NUMERI UGUALI E CONSECUTIVI IN RANGE VARIABILE

Postdi Flash30005 » 15/02/10 13:52

Ok,
allora ora sostituisci le macro (ormai separate per i due conteggi)
con queste
Codice: Seleziona tutto
Sub TrovaU()
UR = Range("B" & Rows.Count).End(xlUp).Row
Range("M3:AI" & UR).ClearContents
For R1 = 3 To UR
    For R2 = 3 To UR
        Conta = 0
        If R1 = R2 Then GoTo saltaR
        For C1 = 2 To 11
            For C2 = 2 To 11
                If Cells(R1, C1).Value = Cells(R2, C2).Value Then
                    Conta = Conta + 1
                End If
            Next C2
saltaC:
        Next C1
        Cells(R1, 13 + Conta).Value = Cells(R1, 13 + Conta).Value + 1
saltaR:
    Next R2
Next R1
Call TrovaC
End Sub
Sub TrovaC()
UR = Range("B" & Rows.Count).End(xlUp).Row
Range("Y3:AI" & UR).ClearContents
For R1 = 3 To UR
    For R2 = 3 To UR
    M_Cons = 0
        Conta = 0
        If R1 = R2 Then GoTo saltaR
        For C1 = 2 To 11
            CCons = 0
            TR = 0
            For C2 = 2 To 11
ciclo:
If C1 = 12 Or C2 = 12 Then GoTo SaltaE
                If Cells(R1, C1).Value = Cells(R2, C2).Value Then
                 CCons = CCons + 1
                    If M_Cons < CCons Then M_Cons = CCons
                    C1 = C1 + 1
                    C2 = C2 + 1
                    TR = 1
                    GoTo ciclo
                End If
SaltaE:
                If TR = 1 Then
                    CCons = 0
                    C1 = C1 - 1
                    GoTo saltaC
                End If
            Next C2
saltaC:
        Next C1
    Cells(R1, 25 + M_Cons).Value = (Cells(R1, 25 + M_Cons).Value + 1)
saltaR:
    Next R2
Next R1
End Sub

Attivando "TrovaU" avrai il prospetto completo
oppure scarica questo file che ha il pulsante "Trova"

Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: NUMERI UGUALI E CONSECUTIVI IN RANGE VARIABILE

Postdi miko » 15/02/10 20:07

ciao flash,
grazie, il codice è fantastico.
ho modificato qualche linea per adattare i risultati al software di cui parlavo prima.
ci sono riuscito solo parzialmante;
ma vorrei il tuo parere.
per quanto riguarda il calcolo dei numeri uguali funziona bene, almeno con i pochi dati che ho a disposizione;
proverò ad inserire più combinazioni ed a confrontare i risultati col software.
nella sub TrovaU ho cancellato le linee:
Codice: Seleziona tutto
---
If R1 = R2 Then 'GoTo saltaR
---
saltaC
---
saltaR
---

ed il risultato è identico a quello del software.
per la consecutività ho invece risultati parziali.
nella sub TrovaC
ho eliminato le linee:
Codice: Seleziona tutto
----
If R1 = R2 Then GoTo saltaR
----
saltaR
---

ed ho ottenuto soltanto 10 = 1 come volevo, ma gli altri dati non sono riuscito ad ottenerli;
cosa devo modificare nella sub della consecutività per ottenere:
primo confronto, combinazioni 1 e 2
--
4 = 1 (i numeri uguali 14-15-17-18 formano la quaterna) e non 2=1 come ottengo ora
--
10 = 1 (risultato che ho già ottenuto eliminando le linee di codice precedente);

secondo confronto, combinazioni 1 e 3:
--
2 = 1 (lunghezza della coppia delle due coppie di numeri uguali 1-4 e 16-17)
--
4 = 1 (come prima)
--
10 = 1 (come prima)
in pratica come si evince dalla figura del mio precedente post.
cosa ne pensi delle modifiche che ho apportato?
grazie ancora
ciao
windows 10 - office 2013
miko
Utente Senior
 
Post: 520
Iscritto il: 29/12/09 10:44

Re: NUMERI UGUALI E CONSECUTIVI IN RANGE VARIABILE

Postdi Flash30005 » 15/02/10 21:50

Beh togliendo quelle righe
Codice: Seleziona tutto
If R1 = R2 then goto salta

Ottieni sì 10 ripetizioni: stai controllando la stessa riga :D
e questo mi sembra una cosa alquanto sciocca (ogni riga è uguale a se stessa) e non stai più controllando una estrazione rispetto alle altre. :o
Per quanto riguarda
4 = 1 (i numeri uguali 14-15-17-18 formano la quaterna) e non 2=1 come ottengo ora
Non è vero perché tra 14-15 e 17-18 hai 16 che interrompe la consecutività
a questo punto penso che il bug ce l'abbia il
miko ha scritto: software, costoso e licenziato, ...

Qui
miko ha scritto:(lunghezza della coppia delle due coppie di numeri uguali 1-4 e 16-17)

non ho capito cosa vorresti al termine del processo della riga uno con la riga tre
la mia macro fornisce 1 consecutività con 2 numeri consecutivi solo che sommando un'altra consecutività della seconda riga avrai, al termine del processo della terza riga il valore 2 a due consecutività (1+1).

Cerca di mantenere la "calma" davanti a tutti questi numeri perché i neuroni possono fare tilt :lol:

Ciao

P.s. Invio il file con macro modificata per le consecutività.
Questa macro non controlla se l'estrazione di comparazione non è perfettamente uguale in consecutività ma controlla se nell'estrazione che sta processando ci sono numeri consecutivi usciti anche non consecutivi nell'estrazione di confronto.

ATTENZIONE! P.S: aggiunto il 16/02/2010 ore 11:20
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: NUMERI UGUALI E CONSECUTIVI IN RANGE VARIABILE

Postdi miko » 19/02/10 12:00

ciao,
ho provato il tuo file, è fantastico, ovviamente;
avevo trovato la soluzione, non ho avuto il tempo di avvisarti;
ho potuto solo inviarti i file dell'altro mio topic.
francamente, meglio così, perchè non mi fido della modifica che ho fatto.
considerando la sub per il calcolo dei consecutivi, confrontando il codice che ho modificato ed il tuo originale, i listati sono diversi, mentre i risultati gli stessi;
ho modificato così:
Codice: Seleziona tutto
---
SaltaE:
                If TR = 2 Then   '<<<< invece di TR = 1
                    CCons = 0
---

invece tu hai aggiunto:
Codice: Seleziona tutto
----
Else
                    If TR = 1 Then
                    C2 = C2 + 1
                    GoTo ciclo
                    End If
----

lasciando il resto invariato.
se e quando avrai tempo, puoi spiegarmi la differenza tra i due codici?
mi piacerebbe capire
grazie ancora
saluti miko
windows 10 - office 2013
miko
Utente Senior
 
Post: 520
Iscritto il: 29/12/09 10:44

Re: NUMERI UGUALI E CONSECUTIVI IN RANGE VARIABILE

Postdi Flash30005 » 19/02/10 13:39

Se metti
miko ha scritto:---
SaltaE:
If TR = 2 Then '<<<< invece di TR = 1
CCons = 0
---

è come eliminare il codice contenuto nella condizione in quanto TR non sarà mai uguale a 2 (o 0 o 1)
e quella routine serve per non scansionare l'intera riga, quindi, l'esecuzione dovrebbe essere leggermente più veloce (ci si accorge di questo con migliaia di righe)
---------------
miko ha scritto: If TR = 1 Then
C2 = C2 + 1
GoTo ciclo
End If

Senza questo codice non è possibile determinare se la riga confronto (C2) ha altri numeri uguali (successivamente ad una interruzione con altro valore, nell'esempio il 16)

1 4 5 10 14 15 16 17 18 20
2 5 6 9 10 11 14 15 17 18

Infatti C2= C2 + 1 incrementa una colonna nella riga confronto (riga 1) e con goto ciclo confronto il nuovo valore altrimenti le consecutività dovevano essere uguali
14 15 17 18 riga confronto (riga 1)
14 15 17 18 riga riferimento (riga 2)

Tutto chiaro?

Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: NUMERI UGUALI E CONSECUTIVI IN RANGE VARIABILE

Postdi miko » 19/02/10 13:49

ciao
grazie per le spiegazioni, tutto comprensibile e chiaro
saluti
windows 10 - office 2013
miko
Utente Senior
 
Post: 520
Iscritto il: 29/12/09 10:44

Re: NUMERI UGUALI E CONSECUTIVI IN RANGE VARIABILE

Postdi miko » 07/03/10 11:11

ciao flash,
ho provato ad inserire la progress meter, che ha questo codice:
Codice: Seleziona tutto
Dim Percent As Single
Percent = a / b     'questa riga  calcolo percentuale
Progress_Meter.Show
'con la Userform impostiamo il formato (0%)
'della proprietà Caption del Frame del valore rappresentato da Percent
  With Progress_Meter
  .labPg4v.Caption = Format(Percent, "0%")
 ' questa è l'istruzione che imposta la lunghezza della Label
 'data appunto dal valore Percent moltiplicato la Lunghezza del
 'Frame meno 10 pt. E' questo che provoca l'effetto avanzamento
 'nella label, il cui fondo è 'stato impostato a blu
  .labPg4.Width = Percent * (.labPg4v.Width + 2)
'fine del ciclo with con Progress_Meter
End With
'istruzione che passa il controllo ad altri processi
'passando con Next x alla riga successiva per ripetere tutto il ciclo
  DoEvents

nella sub trova, ma non funziona e non riesco a capire i valori che devo assegnare alle due variabili a e b della linea percent.
puoi darmi indicazioni?
grazie
ciao
windows 10 - office 2013
miko
Utente Senior
 
Post: 520
Iscritto il: 29/12/09 10:44

Re: NUMERI UGUALI E CONSECUTIVI IN RANGE VARIABILE

Postdi Flash30005 » 07/03/10 13:38

Beh certo non è semplice inserire la barra se non si sa quali sono i due parametri
allora...
b corrisponde alle combinazioni che si possono verificare
a sono quelle che si verificano man mano che avviene l'elaborazione
le combinazioni sono il numero di righe * il n righe -1
su 6 righe avrai 30 combinazioni (6*5)
quindi
b = (UR - 2) * (UR - 2 - 1)
il 2 detrae l'inizio del'elaborazione (testata)
per a avremo (il numero di volte del passaggio di R1 * x + R2)
x (coefficiente) moltiplica il numero di righe primo for.. next altrimenti al secondo passaggio sarebbe inferiore al primo passaggio e ultimo R2
Ma è meglio che pubblichi la modifica così interpreti con più chiarezza il tutto
sostituisci solo la macro TrovaU così

Codice: Seleziona tutto
Public a, b As Integer
Sub TrovaU()
Dim CoeffR As Integer
CoeffR = 1
UR = Range("B" & Rows.Count).End(xlUp).Row
Range("M3:AI" & UR).ClearContents
b = (UR - 2) * (UR - 2 - 1)
LungR = Len(UR)
For FR = 2 To LungR
    CoeffR = CoeffR * 10
Next FR
For R1 = 3 To UR
B1 = (R1 - 2) * CoeffR
    For R2 = 3 To UR
    a = B1 + R2 - 2
    Call Barra
        Conta = 0
        If R1 = R2 Then GoTo saltaR
        For C1 = 2 To 11
            For C2 = 2 To 11
                If Cells(R1, C1).Value = Cells(R2, C2).Value Then
                    Conta = Conta + 1
                End If
            Next C2
saltaC:
        Next C1
        Cells(R1, 13 + Conta).Value = Cells(R1, 13 + Conta).Value + 1
saltaR:
    Next R2
Next R1
Call TrovaC
Unload Progress_Meter
End Sub


poi inserisci la tua macro Barra così
Codice: Seleziona tutto
Sub Barra()
Dim Percent As Single
Percent = a / b     'questa riga  calcolo percentuale
Progress_Meter.Show
'con la Userform impostiamo il formato (0%)
'della proprietà Caption del Frame del valore rappresentato da Percent
  With Progress_Meter
  .labPg4v.Caption = Format(Percent, "0%")
' questa è l'istruzione che imposta la lunghezza della Label
'data appunto dal valore Percent moltiplicato la Lunghezza del
'Frame meno 10 pt. E' questo che provoca l'effetto avanzamento
'nella label, il cui fondo è 'stato impostato a blu
  .labPg4.Width = Percent * (.labPg4v.Width + 2)
'fine del ciclo with con Progress_Meter
End With
'istruzione che passa il controllo ad altri processi
'passando con Next x alla riga successiva per ripetere tutto il ciclo
  DoEvents

End Sub


Ciao
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: NUMERI UGUALI E CONSECUTIVI IN RANGE VARIABILE

Postdi miko » 08/03/10 11:02

ciao,
ho provato il tuo ultimo codice ma ci sono dei problemi;
1) nella macro manca la chiamata alla sub che importa le nuove combinazioni dell'archivio;
allora ho inserito la call importa archivio;
la macro,dopo aver importato l'archivio, non esegue il calcolo dei numeri uguali ma passa direttamente al calcolo dei numeri consecutivi.
2) ho tolto la chiamata alla sub importa archivio ed ho lasciato le combinazioni dell'archivio; in questo caso la macro esegue il calcolo sia dei numeri uguali che dei consecutivi, ma la progress meter funziona solo per il calcolo dei numeri uguali; la barra di avanzamento raggiunge la fine ed assume il valore 102 e la progress meter rimane attiva, ma senza variazioni, fino alla fine del calcolo dei numeri consecutivi.
ti invio la macro originale, del 16/02/2010 ore 11:20, che funziona benissimo, e per me è anche più comprensibile;
http://www.filedropper.com/numeriuguali
in fondo al listato troverai il codice originale della progress meter che abbiamo usato per la frequenza dei terni
ciao grazie
windows 10 - office 2013
miko
Utente Senior
 
Post: 520
Iscritto il: 29/12/09 10:44

Re: NUMERI UGUALI E CONSECUTIVI IN RANGE VARIABILE

Postdi Flash30005 » 08/03/10 11:15

Darò un'occhiata al file ma sinceramente non ho capito bene cosa ti succede
(sto ancora scaricando il file quindi approfondirò)

Ma invece della barra che stai utilizzando avessi utilizzato la barra di excel che ti consigliai all'inizio dei tuoi post ora non avremmo avuto tutti questi problemi

Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: NUMERI UGUALI E CONSECUTIVI IN RANGE VARIABILE

Postdi Flash30005 » 08/03/10 13:02

Hai cambiato i nomi di alcune macro e modificato qualcosa rispetto al file inviato il 15/02/2010

Comunque ora prova questo file

Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: NUMERI UGUALI E CONSECUTIVI IN RANGE VARIABILE

Postdi miko » 08/03/10 13:31

salve ho provato il file, grandioso;
funziona perfettamente.
bella anche la scelta di usare la stessa progress bar per due volte.
i tempi di elaborazione poi sono veramente brevi.
grazie
ciao
windows 10 - office 2013
miko
Utente Senior
 
Post: 520
Iscritto il: 29/12/09 10:44

Re: NUMERI UGUALI E CONSECUTIVI IN RANGE VARIABILE

Postdi Flash30005 » 08/03/10 14:09

Se vuoi puoi ottenere la stessa barra (senza che ricominci due volte)
facendo due semplici modifiche in "Trova_NUMERI_UGUALI"
devi modificare questa riga così:
Codice: Seleziona tutto
b = (ARCHIVIO - 2) * (ARCHIVIO - 2) * 2  '<<< aggiungi il moltiplicatore * 2


e prima del codice chiamata alla macro "Call Trova_NUMERI_CONSECUTIVI"
Codice: Seleziona tutto
'a = 0  '<<<< commenta questa riga

Call Trova_NUMERI_CONSECUTIVI


poi provala
se ti piace di più la lasci così

ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: NUMERI UGUALI E CONSECUTIVI IN RANGE VARIABILE

Postdi miko » 09/03/10 13:57

ciao, grazie per i tuoi ulteriori suggerimenti, utili per comprendere meglio la macro
saluti
windows 10 - office 2013
miko
Utente Senior
 
Post: 520
Iscritto il: 29/12/09 10:44


Torna a Applicazioni Office Windows


Topic correlati a "NUMERI UGUALI E CONSECUTIVI IN RANGE VARIABILE":


Chi c’è in linea

Visitano il forum: Marius44 e 58 ospiti