Condividi:        

2 PUNTI

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

2 PUNTI

Postdi giorgioa » 06/11/22 18:13

Salve a tutti,

cortesemente chiedo se mi potete scrivere una macro

questa macro dovrebbe controllare: se i cinque numeri di riga in quante altre righe fa 2 punti

cerco si spiegarmi meglio la prima riga controlla in quante altre righe trova 2 punti(2 numeri uguali)
la seconda riga controlla anche la prima riga se ci sono 2 numeri uguali e così via

il risultato di ogni riga da trascriverli in foglio Nz da rigo 5 in giu

Grazie
giorgioa
Utente Senior
 
Post: 773
Iscritto il: 16/04/12 15:00

Sponsor
 

Re: 2 PUNTI

Postdi giorgioa » 06/11/22 18:16

vorrei allegare il file
giorgioa
Utente Senior
 
Post: 773
Iscritto il: 16/04/12 15:00

Re: 2 PUNTI

Postdi Anthony47 » 06/11/22 19:49

Per le istruzioni su come allegare un file:
viewtopic.php?f=26&t=103893&p=605487#p605487

Magari spiega ancora, in base al contenuto del file, che cosa vorresti poter fare perche' non credo sia tutto chiaro
Avatar utente
Anthony47
Moderatore
 
Post: 19228
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: 2 PUNTI

Postdi giorgioa » 06/11/22 21:46

purtroppo non riesco ad allegare il file
do una ulteriore spiegazione senza pretendere che mi accontentate
es c:g ci sono 5 numeri questi 5 numeri vedere in quante altre cinquine ci sono 2 numeri uguali e in altro foglio colonna c5 segnare in quante cinquine ha trovato i 2 punti
se ci riesco ad allegare va bene e se la mia spiegazione vi è chiara ...
Per ora grazie
giorgioa
Utente Senior
 
Post: 773
Iscritto il: 16/04/12 15:00

Re: 2 PUNTI

Postdi giorgioa » 06/11/22 22:56

22 50 59 57 66
44 39 61 84 1
44 20 28 77 31
68 39 35 83 52
33 2 60 82 11
17 79 21 30 22
16 71 2 53 1
23 22 77 57 20
13 12 55 68 2
65 45 30 69 35

la prima riga ha trovato i 2 punti alla riga 7 con 22 e 57
in altro foglio colonna C5 =1
la seconda riga controlla anche la riga 1 se ci sono 2 numeri uguali come nelle sottostanti.

Di piunon saprei spiegarvi

Salve
giorgioa
Utente Senior
 
Post: 773
Iscritto il: 16/04/12 15:00

Re: 2 PUNTI

Postdi Anthony47 » 07/11/22 01:31

Ad esempio:
Codice: Seleziona tutto
Sub conta2()
Dim Start As Range, cCount As Range, reCnt As Long, myTim As Single
Dim wArr, rArr, I As Long, J As Long, lCnt As Long, K As Long, taPun As Long
'
Set Start = Sheets("FoglioA").Range("A2")       '<<< La cella di inizio della Tabella
Set cCount = Sheets("FoglioA").Range("G1")      '<<< La cella dei risultati
taPun = 2                                       '<<< I punti da raggiungere
'
myTim = Timer
wArr = Start.CurrentRegion.Value
For I = 1 To UBound(wArr) - 1
    rArr = Application.WorksheetFunction.Index(wArr, I, 0)
    For J = I + 1 To UBound(wArr)
        lCnt = 0
        For K = 1 To 5
            If Not IsError(Application.Match(wArr(J, K), rArr, 0)) Then
                lCnt = lCnt + 1
            End If
            If lCnt = taPun Then
                reCnt = reCnt + 1
                Debug.Print I, J, K
'                lCnt = 0
                Exit For
            End If
        Next K
    Next J
Next I
cCount.Value = reCnt
MsgBox ("Completato, sec. " & Format(Timer - myTim, "0.00"))
End Sub

Le righe marcate <<< vanno compilate come da commento.
Ho immaginato che il tabellone sia "isolato" da eventuali altri dati presenti sul foglio (una colonna libera alla destra e anche a sinistra, se non parte da colonna A; una riga vuota sotto e anche sopra, se non parte da riga1)

Prova e fai sapere...
Avatar utente
Anthony47
Moderatore
 
Post: 19228
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: 2 PUNTI

Postdi giorgioa » 07/11/22 08:59

Salve,

wArr = Start.Range("a2:e100").Value 'CurrentRegion.Value
come sistemare questa riga di codice
spiego: è un foglio archivio e quindi a fianco ci sono altri dati se di current region in basso si
anche perche si effettua l'aggiornamento per estrazione;

poi pesno che il calcolo lo faccia se trova uno dei 5 numeri invece deve contare in quante righe trova 2 numeri della prima cinquina

poi il conteggio deve essere fatto la prima con le rimanenti righe poniamo 100 righe quella cinquina deve controllare le altre 99 e
ma deve continuare a fare il ripasso a tutte le cinquine cioè la seconda riga contando dalla prima ed escluso se stessa le 99 cinquine
ecc
Cioè ogni cinquina deve avere in quante cinquine ci sono 2 punti o almeno 2
giorgioa
Utente Senior
 
Post: 773
Iscritto il: 16/04/12 15:00

Re: 2 PUNTI

Postdi Anthony47 » 07/11/22 12:56

Se la tabella con le estrazioni non è "isolata" allora sostituisci la riga wArr = Start.CurrentRegion.Value con
Codice: Seleziona tutto
wArr = Range(Start, Start.End(xlDown)).Resize(, 5).Value

Ricorda che in Set Start = Sheets("etc etc devi inserire la prima CELLA, non la prima riga della tabella

Fai sapere...
Avatar utente
Anthony47
Moderatore
 
Post: 19228
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: 2 PUNTI

Postdi giorgioa » 07/11/22 14:18

Ok ho apportato la correzione o meglio sostituito il codice di riga,

quando hai tempo ci sarebbe da sistemare quante ne trova con 2 punti

ma l'analisi va fatte su tutte di ogni cinquina.
Vedo di darti uno spunto cosi puoi lavorare sul certo.
dopo = trovi che quella cinquina ha altri con 2 punti

72 12 42 57 31 = 1
18 67 87 7 26 = 3
67 86 41 60 31 = 1
18 79 87 68 22 = 6
34 8 36 18 60 = 2
16 51 78 72 7 = 3
57 80 82 5 23 = 6
56 57 88 1 23 = 5
64 72 70 54 27 = 4
66 69 87 1 57 = 5
84 16 72 45 12 = 4
50 27 51 43 63 = 1
4 19 59 27 71 = 2
15 86 36 87 46 = 1
55 20 53 76 28 = 1
22 11 36 54 49 = 2
87 27 10 2 32 = 1
1 14 57 22 89 = 7
50 23 46 34 66 = 3
66 82 74 49 20 = 1
51 82 4 6 3 = 1
62 29 57 16 80 = 1
2 15 49 39 62 = 1
73 50 69 80 63 = 2
53 12 49 5 9 = 3
60 47 68 6 17 = 0
90 42 84 7 52 = 5
46 33 80 22 5 = 2
61 64 31 67 37 = 2
39 15 42 23 13 = 2
42 61 82 53 30 = 0
47 42 10 66 86 = 1
58 35 65 53 79 = 4
36 84 37 60 16 = 3
74 53 5 37 54 = 2
25 86 21 38 7 = 2
4 28 29 15 13 = 2
89 34 14 3 6 = 5
37 65 79 9 4 = 4
61 17 57 66 67 = 4
29 53 12 32 69 = 1
17 71 7 90 54 = 4
71 70 20 64 7 = 5
49 5 84 63 82 = 3
88 60 10 4 89 = 0
78 52 66 34 7 = 5
55 44 33 7 38 = 2
46 2 68 83 41 = 3
17 27 83 21 56 = 3
63 15 71 8 44 = 0
78 62 47 54 18 = 0
40 41 42 47 52 = 2
68 28 87 14 34 = 2
28 90 72 70 16 = 3
52 45 51 71 38 = 0
22 48 67 18 30 = 6
47 18 62 56 48 = 1
15 79 68 4 81 = 4
59 38 11 88 54 = 1
66 40 44 70 7 = 5
34 36 72 50 89 = 3
68 59 26 10 67 = 3
2 81 55 22 25 = 2
14 76 38 74 39 = 1
11 22 1 87 48 = 6
58 33 30 16 17 = 1
83 78 90 52 37 = 3
22 81 46 7 90 = 4
68 69 63 26 20 = 2
12 66 89 22 37 = 2
58 38 40 15 69 = 0
17 36 67 78 3 = 1
23 5 21 83 61 = 2
22 73 86 77 6 = 3
40 61 44 14 84 = 1
41 46 73 6 32 = 2
4 49 57 79 48 = 2
22 50 59 67 66 = 5
44 39 61 84 1 = 1
44 20 28 77 31 = 3
68 39 35 83 52 = 3
33 2 60 82 11 = 0
17 79 21 30 22 = 4
16 71 2 53 1 = 1
23 22 77 57 20 = 6
13 12 55 68 2 = 2
65 45 30 69 35 = 1
3 13 86 88 43 = 0
27 78 81 65 75 = 1
15 56 21 90 36 = 2
87 48 8 77 43 = 1
50 33 20 79 54 = 0
3 70 9 38 21 = 1
27 1 60 61 78 = 2
53 11 65 16 37 = 5
28 14 68 34 39 = 3
86 70 32 27 4 = 3
86 77 1 28 57 = 6
77 7 70 27 4 = 4
65 23 48 12 58 = 1
71 83 7 6 29 = 2
giorgioa
Utente Senior
 
Post: 773
Iscritto il: 16/04/12 15:00

Re: 2 PUNTI

Postdi Anthony47 » 07/11/22 15:23

quando hai tempo ci sarebbe da sistemare quante ne trova con 2 punti

ma l'analisi va fatte su tutte di ogni cinquina.
Vedo di darti uno spunto cosi puoi lavorare sul certo.
dopo = trovi che quella cinquina ha altri con 2 punti

Non mi serve uno spunto ma una descrizione fatta a chi (come me) non sa niente di quello che tu stai facendo...
Cerco di interpretare dalla lista che hai allegato: vorresti quindi un riepilogo che dia per ogni riga quante volte i suoi numeri figurino (almeno) 2 volte nelle altre righe (non un riepilogo unico in una sola cella).

Se è così allora prova questa versione:
Codice: Seleziona tutto
Sub conta2()
Dim Start As Range, cCount As Range, reCnt As Long, myTim As Single
Dim wArr, rArr, I As Long, J As Long, lCnt As Long, K As Long, taPun As Long
'
Set Start = Sheets("FoglioA").Range("A2")       '<<< La cella di inizio della Tabella
Set cCount = Sheets("FoglioA").Range("G2")      '<<< La cella di inizio dei risultati
taPun = 2                                       '<<< I punti da raggiungere
'
myTim = Timer
wArr = Range(Start, Start.End(xlDown)).Resize(, 5).Value
cCount.Resize(UBound(wArr) + 5, 1).ClearContents    'Azzera area dei risultati
For I = 1 To UBound(wArr)
    rArr = Application.WorksheetFunction.Index(wArr, I, 0)
    For J = 1 To UBound(wArr)
    If I <> J Then
        lCnt = 0
        For K = 1 To 5
            If Not IsError(Application.Match(wArr(J, K), rArr, 0)) Then
                lCnt = lCnt + 1
            End If
            If lCnt = taPun Then
                reCnt = reCnt + 1
'                Debug.Print I, J, K
                Exit For
            End If
        Next K
    End If
    Next J
    cCount.Cells(I, 1) = reCnt
    reCnt = 0
Next I
MsgBox ("Completato, sec. " & Format(Timer - myTim, "0.00"))
End Sub

Fai sapere...
Avatar utente
Anthony47
Moderatore
 
Post: 19228
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: 2 PUNTI

Postdi giorgioa » 07/11/22 17:07

Il codice funziona perfettamente "quasi"

cioè quando trova 3 numeri li considera come 1
cioè i 2 punti secchi sono 58 (es) e trova una cinquina con 3 numeri
conta 58+1 = 59
si potrebbe avere che quando trova tre numeri invece di aggiungere 1 aggiunge 3 per ogni terno che trova?
cioè 58 (trova una da 3 numeri)+3=61
Al contrario se più sbrigativo porti a 3 numeri .

Ma quello che mi hai scritto cmq già mi sta bene
giorgioa
Utente Senior
 
Post: 773
Iscritto il: 16/04/12 15:00

Re: 2 PUNTI

Postdi Anthony47 » 07/11/22 17:44

Per contare 3 in caso trovi "almeno 3 numeri uguali" allora prova così:
Codice: Seleziona tutto
Sub conta23()
Dim Start As Range, cCount As Range, reCnt As Long, myTim As Single
Dim wArr, rArr, I As Long, J As Long, lCnt As Long, K As Long, taPun As Long
'
Set Start = Sheets("FoglioA").Range("A2")       '<<< La cella di inizio della Tabella
Set cCount = Sheets("FoglioA").Range("G2")      '<<< La cella di inizio dei risultati
''taPun = 2                                       '<<< I punti da raggiungere
'
myTim = Timer
'wArr = Start.CurrentRegion.Value
wArr = Range(Start, Start.End(xlDown)).Resize(, 5).Value
cCount.Resize(UBound(wArr) + 5, 1).ClearContents    'Azzera area dei risultati
For I = 1 To UBound(wArr)
    rArr = Application.WorksheetFunction.Index(wArr, I, 0)
    For J = 1 To UBound(wArr)
    If I <> J Then
        lCnt = 0
        For K = 1 To 5
            If Not IsError(Application.Match(wArr(J, K), rArr, 0)) Then
                lCnt = lCnt + 1
            End If
        Next K
        If lCnt = 2 Then
            reCnt = reCnt + 1
        ElseIf lCnt > 2 Then
            reCnt = reCnt + 3
        End If
    End If
    Next J
    cCount.Cells(I, 1) = reCnt
    reCnt = 0
Next I
MsgBox ("Completato, sec. " & Format(Timer - myTim, "0.00"))
End Sub

Non voglio sapere cosa contare nell'ipotesi che trovi 4 numeri, o miracolosamente 5 :D

Al contrario se più sbrigativo porti a 3 numeri .
Questa non l'ho capita ma ho capito che la proposta appena fatta va bene, se funziona
(ma se volevi dire "contiamo non quante volta trova 2 numeri ma quante volte ne trova 3 allora basterebbe modificare taPun = 3)
Avatar utente
Anthony47
Moderatore
 
Post: 19228
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: 2 PUNTI

Postdi giorgioa » 07/11/22 21:25

giorgioa
Utente Senior
 
Post: 773
Iscritto il: 16/04/12 15:00

Re: 2 PUNTI

Postdi giorgioa » 07/11/22 21:30

EUREKA MI SONO FATTO SPIEGARE COME ALLEGARE IL FILE
giorgioa
Utente Senior
 
Post: 773
Iscritto il: 16/04/12 15:00

Re: 2 PUNTI

Postdi giorgioa » 07/11/22 22:08

giorgioa ha scritto:https://1drv.ms/x/s!AoUgxEWS5dZ8gTSqw0Nac-dRRDtT?e=3zQMDo


Porti ai 3 punti
era per non farti rifare il lavoro allora mi son detto che conti solo i 3 punti

ma intanto avrei dovuto impegnare un'altra colonna.

Ho provato il Punti23 e va benissimo
Mi ritengo soddisfattissimo.

So che non sei interessato ma il lavoro che mi hai fatto è perchè lavoro su frequenze
prendendo in considerazione le prime 10 cinquine e facendo degli scarti.

dimmi se e quando vuoi che chiuda l'argomento

Grazie
giorgioa
Utente Senior
 
Post: 773
Iscritto il: 16/04/12 15:00

Re: 2 PUNTI

Postdi Anthony47 » 07/11/22 22:20

Ho provato il Punti23 e va benissimo
Mi ritengo soddisfattissimo.
Tutto e' bene quel che finisce benissimo

So che non sei interessato ma il lavoro che mi hai fatto è perchè lavoro su frequenze
prendendo in considerazione le prime 10 cinquine e facendo degli scarti.
E' che, lavorando coi numeri, so che certi calcoli non portano a niente di utile.
Io, quando voglio giocare, punto si 1, 2, 3 e 4, cinquina secca sulla ruota di Alberobello e ho "quasi" le stesse chances

Se il problema e' risolto con Sub Conta23 allora considero la discussione Risolta; se qualcosa non va allora scrivi con qualche dettaglio e vedremo cosa si puo' fare

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19228
Iscritto il: 21/03/06 16:03
Località: Ivrea


Torna a Applicazioni Office Windows


Topic correlati a "2 PUNTI":


Chi c’è in linea

Visitano il forum: Nessuno e 48 ospiti