Condividi:        

contare la consecutivita

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

contare la consecutivita

Postdi raimea » 23/01/23 08:13

ciao
tramite macro
vorrei compilare la tabella consecutivita' in fgl squadre Col AC7:AC21

analizzando fgl generale col K8:K
contare quante volte ho avuto 1 sola consec. con segno V e poi 1na Con P
poi quante volte ho avuto 2 volte consec. V e poi 2 volte P
quante volte ho avuto 3 volte consec. V e poi 3 volte P ecc...

andando a riportare i dati ottenuti in fgl squadre
col AD7:AD21 per le vincite V consec.
e col AE7:AE21 per le perdite P consec.

vi allego il file

https://www.dropbox.com/scl/fo/5w3u7mdfgubdzhf3ze9Zc/h?dl=0&rlkey=r7g4chg7o83usbxp1b8zysw21

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

Sponsor
 

Re: contare la consecutivita

Postdi Anthony47 » 23/01/23 11:11

Il link allegato non funziona...
Avatar utente
Anthony47
Moderatore
 
Post: 19446
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: contare la consecutivita

Postdi raimea » 23/01/23 12:29

scusate...
ho sbagliato a mettere il link !! :oops: :oops:

ecco il link corretto
riferito al 1mo post:

https://www.dropbox.com/scl/fi/i6khp1gk879lv44aub01a/consecutivita.xlsm?dl=0&rlkey=l7azkhx11b80fhzg2mtc4evf5

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

Re: contare la consecutivita

Postdi Anthony47 » 23/01/23 15:32

A me questa sembra funzionare:
Codice: Seleziona tutto
Sub Consec()
Dim strVP As String, I As Long, J As Long, Ck As String
Dim lDiff As Long, oArr(1 To 15, 1 To 2)
'
strVP = Application.WorksheetFunction.TextJoin("", True, Sheets("generale").Range("K8:K10000"))
For I = 15 To 1 Step -1
    For J = 1 To 2
        If J = 1 Then Ck = "V" Else Ck = "P"
        lDiff = Len(strVP) - Len(Replace(strVP, String(I, Ck), "", , , vbTextCompare))
        If lDiff > 0 Then
            oArr(I, J) = lDiff / I
            strVP = Replace(strVP, String(I, Ck), "###", , , vbTextCompare)
        End If
    Next J
Next I
Sheets("Squadre").Range("AD7").Resize(15, 2).Value = oArr
End Sub

..e i risultati mi sembrano pure giusti :D
Avatar utente
Anthony47
Moderatore
 
Post: 19446
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: contare la consecutivita

Postdi raimea » 23/01/23 18:24

ciao
e' 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: contare la consecutivita

Postdi raimea » 22/12/23 21:27

ciao
la macro Consec in modulo 5
pare non faccia i conteggi corretti delle consecutivita'
in fgl tabelle col AD

l' ultima sequenza di Vinti V in fgl generale e' di 17 consecutivi
ma la macro non lo riporta

vi allego il file

https://www.dropbox.com/scl/fi/hgg2nltxjz50k7v0n66oi/Consecutivita_V_P.xlsm?rlkey=7v4kf4a2bg617akcbabcilxjz&dl=0

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

Re: contare la consecutivita

Postdi Anthony47 » 22/12/23 22:57

La macro precedente calcolava fino a 15, perche' così era impostato il file di esempio che pubblicasti.

Per poter gestire il limite come impostato in foglio Tabelle colonna AC ho fatto un paio di modifiche qua e là; il nuovo codice complessivo:
Codice: Seleziona tutto
Sub ConsecFlex()
Dim strVP As String, i As Long, J As Long, Ck As String
Dim lDiff As Long, oArr()
'------------------
' serve compilare tabella consecutivita fgl Tabelle
' pc - facile   gennaio 23
'  http://www.pc-facile.com/forum/viewtopic.php?f=26&t=112784&p=663028#p663028
'----------------------
Worksheets("Tabelle").Unprotect   ' togli protez
maxx = Application.WorksheetFunction.Max(Sheets("Tabelle").Range("AC:AC"))
ReDim oArr(1 To maxx, 1 To 2)
strVP = Application.WorksheetFunction.TextJoin("", True, Sheets("generale").Range("K8:K10000"))
For i = maxx To 1 Step -1
    For J = 1 To 2
        If J = 1 Then Ck = "V" Else Ck = "P"
        lDiff = Len(strVP) - Len(Replace(strVP, String(i, Ck), "", , , vbTextCompare))
        If lDiff > 0 Then
            oArr(i, J) = lDiff / i
            strVP = Replace(strVP, String(i, Ck), "###", , , vbTextCompare)
        End If
    Next J
Next i
Sheets("Tabelle").Range("AD7").Resize(maxx, 2).Value = oArr

  '-------coloro riga si no --------------------------------
   
      For Z = 7 To Cells(Rows.Count, "AC").End(xlUp).Row  ' 7 1ma riga
   
    Range("AC7:AE1000").Interior.ColorIndex = 2  '<<< sfondo bianco
    Range("AC7:AE1000").Font.Bold = False
    Next Z
   
    For RR = 7 To Z Step 2
       Range("AC" & RR & ":AE" & RR).Interior.ColorIndex = 8 ' azzurro chiaro
       Range("AC" & RR & ":AE" & RR).Font.Bold = True
    Next RR

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

End Sub

Prova...
Avatar utente
Anthony47
Moderatore
 
Post: 19446
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: contare la consecutivita

Postdi raimea » 23/12/23 10:23

ciao
tutto ok

grazie

e BUONE FESTE

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

Re: contare la consecutivita

Postdi raimea » 02/10/24 21:07

ciao
questa macro funziona
Codice: Seleziona tutto
Sub ConsecFlex()
Dim strVP As String, i As Long, J As Long, Ck As String
Dim lDiff As Long, oArr()
'------------------
' serve compilare tabella consecutivita fgl Tabelle
' pc - facile   gennaio 23
'  http://www.pc-facile.com/forum/viewtopic.php?f=26&t=112784&p=663028#p663028
'----------------------
Worksheets("Tabelle").Unprotect   ' togli protez

maxx = Application.WorksheetFunction.Max(Sheets("Tabelle").Range("AC:AC"))

ReDim oArr(1 To maxx, 1 To 2)
strVP = Application.WorksheetFunction.TextJoin("", True, Sheets("generale").Range("K8:K10000"))

For i = maxx To 1 Step -1
    For J = 1 To 2
        If J = 1 Then Ck = "V" Else Ck = "P"
        lDiff = Len(strVP) - Len(Replace(strVP, String(i, Ck), "", , , vbTextCompare))
        If lDiff > 0 Then
            oArr(i, J) = lDiff / i
            strVP = Replace(strVP, String(i, Ck), "###", , , vbTextCompare)
        End If
    Next J
Next i

Sheets("Tabelle").Range("AD7").Resize(maxx, 2).Value = oArr

  '-------coloro riga si no --------------------------------
   
      For Z = 7 To Cells(Rows.Count, "AC").End(xlUp).Row  ' 7 1ma riga
   
    Range("AC7:AE1000").Interior.ColorIndex = 2  '<<< sfondo bianco
    Range("AC7:AE1000").Font.Bold = False
    Next Z
   
    For RR = 7 To Z Step 2
       Range("AC" & RR & ":AE" & RR).Interior.ColorIndex = 8 ' azzurro chiaro
       Range("AC" & RR & ":AE" & RR).Font.Bold = True
    Next RR

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

End Sub



ora dovrei fare gli stessi conteggi
con gli stessi riferimenti e nome fogli

MA
anzicche cercare e contare le lettere V _ P

deve cercare contare la frase Vinta _ Persa

ho provato a modivicare V=Vinta e P=Persa

ma non fa i conteggi corretti

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

Re: contare la consecutivita

Postdi Anthony47 » 03/10/24 00:20

1) Ho modificato le istruzioni marcate ** in questo blocco:
Codice: Seleziona tutto
    For J = 1 To 2
        If J = 1 Then Ck = "Vinta" Else Ck = "Persa"                                        '**
        lDiff = Len(strVP) - Len(Replace(strVP, StringW(i, Ck), "", , , vbTextCompare))     '**
        If lDiff > 0 Then
            oArr(i, J) = lDiff / i / Len(Ck)                                                '**
            strVP = Replace(strVP, StringW(i, Ck), "###", , , vbTextCompare)                '**
        End If
    Next J

2) Ho aggiunto questa funzione:
Codice: Seleziona tutto
Function StringW(ByVal hMany As Long, ByVal lStr As String) As String
Dim lWk As String, lI As Long
'
For lI = 1 To hMany
    lWk = lWk & lStr
Next lI
StringW = lWk
End Function

A occhio mi sembra che dia risultati ...verosimili
Avatar utente
Anthony47
Moderatore
 
Post: 19446
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: contare la consecutivita

Postdi raimea » 03/10/24 06:14

ciao
e' tutto ok :o

grazie mille
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 "contare la consecutivita":


Chi c’è in linea

Visitano il forum: Nessuno e 8 ospiti