Condividi:        

compilare una tabella : somma gol

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

compilare una tabella : somma gol

Postdi raimea » 06/01/23 22:30

ciao
trami macro vorrei compilare una tabella in fgl squadre

la tabella in col X7:AA ( somma gol volte)

vorrei riuscire a prelevare i valori trovati in fgl generale col. N8

inserirli in fgl squadre col X7 in ordine crescente.

poi ad ogni valore di col X :
contare quante volte e' presente in fgl generale e inserirlo in col Y7
contare quante volte stesso valore e' risultato Vincente V in fgl generale e metterlo in col X
contare quante volte stesso valore e' risultato Perdente P in fgl generale e metterlo in col AA

vi allego il file

https://www.dropbox.com/scl/fi/k68x48xv31azwuj5wxyzj/somma_gol.xlsm?dl=0&rlkey=x2yfs4ksiqe8w8s6y45li6lg6


ciao
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1432
Iscritto il: 11/02/10 07:33
Località: lago

Sponsor
 

Re: compilare una tabella : somma gol

Postdi Anthony47 » 08/01/23 01:10

Ad esempio:
Codice: Seleziona tutto
Sub SumGol()
Dim WArr(), wInd As Long, tArr(1 To 4)
Dim GeS As Worksheet, LastN As Long, myMatch
Dim I As Long, J As Long, cSum
'
Set GeS = Sheets("Generale")
LastN = GeS.Cells(Rows.Count, "N").End(xlUp).Row
ReDim WArr(1 To LastN, 1 To 4)
For I = 8 To LastN
    cSum = GeS.Cells(I, "N")
    myMatch = Application.Match(cSum, GeS.Range("N8").Resize(I - 7, 1), False)
    If IsError(myMatch) Then
        wInd = wInd + 1
        WArr(wInd, 1) = cSum
        WArr(wInd, 2) = 1
        If UCase(GeS.Cells(I, "K").Value) = "V" Then
            WArr(wInd, 3) = 1           'V
        Else
            WArr(wInd, 4) = 1           'P
        End If
    Else
        If myMatch > wInd Then wInd = myMatch
        WArr(myMatch, 1) = cSum
        WArr(myMatch, 2) = WArr(myMatch, 2) + 1
        If UCase(GeS.Cells(I, "K").Value) = "V" Then
            WArr(myMatch, 3) = WArr(myMatch, 3) + 1         'V
        Else
            WArr(myMatch, 4) = WArr(myMatch, 4) + 1         'P
        End If
    End If
Next I
'Sheets("Squadre").Range("AC7").Resize(wInd, 4).Value = WArr
'Bubble sort:
For I = 1 To wInd - 1
    For J = I + 1 To wInd
        If WArr(I, 1) > WArr(J, 1) Then
            tArr(4) = WArr(I, 4)
            tArr(3) = WArr(I, 3)
            tArr(2) = WArr(I, 2)
            tArr(1) = WArr(I, 1)
'
            WArr(I, 4) = WArr(J, 4)
            WArr(I, 3) = WArr(J, 3)
            WArr(I, 2) = WArr(J, 2)
            WArr(I, 1) = WArr(J, 1)
'
            WArr(J, 4) = tArr(4)
            WArr(J, 3) = tArr(3)
            WArr(J, 2) = tArr(2)
            WArr(J, 1) = tArr(1)
        End If
    Next J
Next I
Sheets("Squadre").Range("AC7").Resize(wInd, 4).Value = WArr
End Sub

Per consertirti di paragonare l'output a un eventuale altro metodo che usi oggi, essa scrive in colonn AC; dopo le verifiche del caso modifica quel Range("AC7") (in fondo alla macro) in Range("X7")

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

Re: compilare una tabella : somma gol

Postdi raimea » 08/01/23 08:21

Ciao

la macro sul file allegato e' ok
da il risultato richiesto, scrivendolo da riga 7.

MA
ho fatto un test scrivendo piu dati in col N di fgl generale

la macro riporta in fgl squadre i dati corretti
ma li SCRIVE da riga 8 e non piu da riga 7

ho provato capire perche' ma non l'ho capito.

allego il file con piu dati in col N

https://www.dropbox.com/scl/fi/ccr05on9bi89py00h7r72/somma_gol_2.xlsm?dl=0&rlkey=nnl1vxpf3rby6cjuf3mhpalon

ciao
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1432
Iscritto il: 11/02/10 07:33
Località: lago

Re: compilare una tabella : somma gol

Postdi Marius44 » 08/01/23 10:44

Ciao
Il problema sta nell'ordinamento perchè se fai scrivere i dati prima di ordinarli sono alla riga 7

Ciao,
Mario
Marius44
Utente Senior
 
Post: 658
Iscritto il: 07/09/15 22:00

Re: compilare una tabella : somma gol

Postdi raimea » 08/01/23 11:09

ciao
ok capito

ma io non sono in grado di modificare / sistemare la macro :undecided:

ciao
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1432
Iscritto il: 11/02/10 07:33
Località: lago

Re: compilare una tabella : somma gol

Postdi Anthony47 » 08/01/23 12:06

No, purtroppo non e' un problema di ordinamento ma proprio di ricerca e catalogazione dei dati.
Questa mi sembra giusta:
Codice: Seleziona tutto
Sub SumGol2()
Dim WArr(), wInd As Long, tArr(1 To 4), mArr
Dim GeS As Worksheet, LastN As Long, myMatch
Dim I As Long, J As Long, cSum
'
Set GeS = Sheets("Generale")
LastN = GeS.Cells(Rows.Count, "N").End(xlUp).Row
ReDim WArr(1 To LastN, 1 To 4)
ReDim mArr(1 To LastN)
For I = 8 To LastN
    mArr = Application.WorksheetFunction.Index(WArr, 0, 1)
    cSum = GeS.Cells(I, "N")
    myMatch = Application.Match(cSum, mArr, False)
    If IsError(myMatch) Then
        wInd = wInd + 1
        WArr(wInd, 1) = cSum
        WArr(wInd, 2) = 1
        If UCase(GeS.Cells(I, "K").Value) = "V" Then
            WArr(wInd, 3) = 1           'V
        Else
            WArr(wInd, 4) = 1           'P
        End If
    Else
        WArr(myMatch, 1) = cSum
        WArr(myMatch, 2) = WArr(myMatch, 2) + 1
        If UCase(GeS.Cells(I, "K").Value) = "V" Then
            WArr(myMatch, 3) = WArr(myMatch, 3) + 1         'V
        Else
            WArr(myMatch, 4) = WArr(myMatch, 4) + 1         'P
        End If
    End If
'Sheets("Squadre").Range("AC7").Resize(wInd, 4).Value = WArr
Next I
'Bubble sort:
For I = 1 To wInd - 1
    For J = I + 1 To wInd
        If WArr(I, 1) > WArr(J, 1) Then
            tArr(4) = WArr(I, 4)
            tArr(3) = WArr(I, 3)
            tArr(2) = WArr(I, 2)
            tArr(1) = WArr(I, 1)
'
            WArr(I, 4) = WArr(J, 4)
            WArr(I, 3) = WArr(J, 3)
            WArr(I, 2) = WArr(J, 2)
            WArr(I, 1) = WArr(J, 1)
'
            WArr(J, 4) = tArr(4)
            WArr(J, 3) = tArr(3)
            WArr(J, 2) = tArr(2)
            WArr(J, 1) = tArr(1)
        End If
    Next J
Next I
Sheets("Squadre").Range("AC7").Resize(wInd, 4).Value = WArr
End Sub

Ri-prova...
Avatar utente
Anthony47
Moderatore
 
Post: 19456
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: compilare una tabella : somma gol

Postdi raimea » 08/01/23 13:50

ciao

tutto ok

grazie
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1432
Iscritto il: 11/02/10 07:33
Località: lago

Re: compilare una tabella : somma gol

Postdi Marius44 » 09/01/23 08:43

Ciao
Tutto è bene quel che finisce bene.
Mi lascia, però, perplesso questa tua dichiarazione:
ma io non sono in grado di modificare / sistemare la macro


Con quasi 1400 interventi qualcosa sicuramente hai imparato e, quindi, potresti tentare un abbozzo.
Tieni presente che non vuole essere una critica. Vale anche per me "lato formule" ma almeno ci provo.

Ciao,
Mario
Marius44
Utente Senior
 
Post: 658
Iscritto il: 07/09/15 22:00

Re: compilare una tabella : somma gol

Postdi raimea » 05/10/24 20:47

ciao
sempre nel recuperare un file "corrotto"

dovrei ripristinare la macro >> SumGol (in modulo 2)

Codice: Seleziona tutto
Sub SumGol()

Dim WArr(), wInd As Long, tArr(1 To 4), mArr
Dim GeS As Worksheet, LastN As Long, myMatch
Dim i As Long, j As Long, cSum
'-------------------------
'  gennaio 23
' preleva e ordina la colonna masaniello fgl Tabelle
' da pc-facile antony47
' http://www.pc-facile.com/forum/viewtopic.php?f=26&t=112756&p=662823#p662823
'--------------------------------
Sheets("Tabelle").Select

Application.ScreenUpdating = False  'blocca sfarfallio e non vedo cambiare fgl

INIZIO = Timer
UserForm1.Show vbModeless
DoEvents


Worksheets("Tabelle").Unprotect   ' togli protez

Set GeS = Sheets("Generale")
LastN = GeS.Cells(Rows.Count, "N").End(xlUp).Row

 Range("x7:AA1000").ClearContents ' cnacella elimina dati precedenti
 
ReDim WArr(1 To LastN, 1 To 4)
ReDim mArr(1 To LastN)
For i = 8 To LastN
    mArr = Application.WorksheetFunction.Index(WArr, 0, 1)
    cSum = GeS.Cells(i, "N")
    myMatch = Application.Match(cSum, mArr, False)
    If IsError(myMatch) Then
        wInd = wInd + 1
        WArr(wInd, 1) = cSum
        WArr(wInd, 2) = 1
       
        If UCase(GeS.Cells(i, "K").Value) = "Vinta" Then
       
            WArr(wInd, 3) = 1           'V
        Else
            WArr(wInd, 4) = 1           'P
        End If
    Else
        WArr(myMatch, 1) = cSum
        WArr(myMatch, 2) = WArr(myMatch, 2) + 1
        If UCase(GeS.Cells(i, "K").Value) = "Vinta" Then
            WArr(myMatch, 3) = WArr(myMatch, 3) + 1         'V
        Else
            WArr(myMatch, 4) = WArr(myMatch, 4) + 1         'P
        End If
    End If
   
'Sheets("Tabelle").Range("AC7").Resize(wInd, 4).Value = WArr

Next i

'Bubble sort:
For i = 1 To wInd - 1
    For j = i + 1 To wInd
        If WArr(i, 1) > WArr(j, 1) Then
            tArr(4) = WArr(i, 4)
            tArr(3) = WArr(i, 3)
            tArr(2) = WArr(i, 2)
            tArr(1) = WArr(i, 1)
'
            WArr(i, 4) = WArr(j, 4)
            WArr(i, 3) = WArr(j, 3)
            WArr(i, 2) = WArr(j, 2)
            WArr(i, 1) = WArr(j, 1)
'
            WArr(j, 4) = tArr(4)
            WArr(j, 3) = tArr(3)
            WArr(j, 2) = tArr(2)
            WArr(j, 1) = tArr(1)
        End If
    Next j
Next i

Sheets("Tabelle").Range("X7").Resize(wInd, 4).Value = WArr ' dove mettere i dati

'-----------------------
  '-------coloro riga si no --------------------------------
   
      For Z = 7 To Cells(Rows.Count, "X").End(xlUp).Row  ' 7 1ma riga
   
    Range("X7:AA1000").Interior.ColorIndex = 2  '<<< sfondo bianco
    Range("X7:AA1000").Font.Bold = False
    Next Z
   
    For RR = 7 To Z Step 2
       Range("X" & RR & ":AA" & RR).Interior.ColorIndex = 36
       Range("X" & RR & ":AA" & RR).Font.Bold = True
    Next RR
'---------


   Application.ScreenUpdating = True  ' riattiva sfarfallio
   
Unload UserForm1
fine = Timer
MsgBox ("Tempo impiegato " & Int((fine - INIZIO) / 60) & " min " & (fine - INIZIO) Mod 60 & " Sec")



' -- blocca proteggi foglio----------------------------
   ' ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingColumns:=True, AllowFormattingRows:=True
       
End Sub
 



questa mi dovrebbe prelevare e contare le sigle in fgl generale col N
contare quante volte sono state usate
e riportarlo in fgl tabelle col X7_Y7 ( fin qui funziona)

poi
per ogni sigla trovata dirmi quante volte trova
Vinta / Persa in fgl generale col K8:K ( questo non funziona)
e riportarlo in fgl tabelle col Z _ AB

vi allego il file

https://www.dropbox.com/scl/fi/vw5l6q0fc24aj32k47ojf/masaniello.xlsm?rlkey=absoiq8lzaweabbgz1cykxhky&st=y51fwhef&dl=0

grazie
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1432
Iscritto il: 11/02/10 07:33
Località: lago

Re: compilare una tabella : somma gol

Postdi Anthony47 » 06/10/24 23:14

Hai usato UCase (cioè Maiuscolo) in If UCase(GeS.Cells(i, "K").Value) quindi dovrai scrivere (2 posti)
Codice: Seleziona tutto
If UCase(GeS.Cells(i, "K").Value) = "VINTA" Then    'NON "Vinta"
Avatar utente
Anthony47
Moderatore
 
Post: 19456
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: compilare una tabella : somma gol

Postdi raimea » 07/10/24 05:53

ciao

tutto ok

ho sostituito la riga corretta del codice, in 2 punti.

grazie
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1432
Iscritto il: 11/02/10 07:33
Località: lago


Torna a Applicazioni Office Windows


Topic correlati a "compilare una tabella : somma gol":


Chi c’è in linea

Visitano il forum: Nessuno e 30 ospiti