resa giornaliera

[raimea]

ciao
tramite macro vorrei fare la somma della resa finale di una giornata.

analizzando le date in fgl dalambert col B6:B
vorrei calcolare il totale della stessa giornata
sommando i dati in fgl dalambert col W6:W

i dati sono poi da scrivere in fgl squadre
col AG7:AG le date, mentre il risultato della stessa giornata in col AH7:AH

PS
potrebbero esserci dei giorni senza giocate
quindi vanno riportate solo le date con giocate.

vi allego il file

https://www.dropbox.com/scl/fi/yesn0j07wt7g5ztwbkq4m/resa-giornaliera.xlsm?dl=0&rlkey=yiwclsp6pgl6kbbqbo8h8ergp

ciao

[Marius44]

Ciao
Sono impegnato e non posso farlo io.
Fai così:
primo ciclo che scansiona le date
quando la data cambia assume riga di partenza e riga di arrivo (meno 1 perchè non ti serve la riga della nuova data),
fai la somma dell'intervallo),
vai al foglio e scrivi data e importo
azzera le variabili utilizzate e riparti col primo ciclo

Ciao,
Mario

[raimea]

ciao Mario
pur avendo capito il tuo ragionamento
io non sono in grado di scrivere tale codice
partendo da zero.


con le mie conoscenze, ottenuto il codice base, poi riuscirò a gestire tutto ciò che
serve come extra.


per ora attendo, nel caso tu trovi il tempo /voglia di pubblicare questo codice.


ciao

[Anthony47]

Ad esempio:

Codice: Seleziona tutto

Sub Riep()
Dim StarD As Range, StarW As Range, StarOut As Range
Dim oArr(), lunDat As Long, oInd As Long, i As Long
Dim MinDa As Long, MaxDa As Long
'
'Definizioni:
Set StarD = Sheets("dalambert").Range("B6")
Set StarW = Sheets("dalambert").Range("W6")
Set StarOut = Sheets("Squadre").Range("AG7")
'
lunDat = StarD.Offset(10000, 0).End(xlUp).Row - StarD.Row + 1
MinDa = Application.WorksheetFunction.Min(StarD.Resize(lunDat, 1))
MaxDa = Application.WorksheetFunction.Max(StarD.Resize(lunDat, 1))
'Raccoglie dati:
ReDim oArr(MinDa To MaxDa, 1 To 2)
For i = 1 To lunDat
    If IsDate(StarD.Cells(i, 1)) Then
        oArr(StarD.Cells(i, 1), 1) = StarD.Cells(i, 1)
        oArr(StarD.Cells(i, 1), 2) = oArr(StarD.Cells(i, 1), 2) + StarW.Cells(i, 1)
    End If
Next i
'Scrivi risultati:
StarOut.Offset(1, 0).Resize(lunDat, 2).Clear
For i = LBound(oArr) To UBound(oArr)
    If oArr(i, 1) <> "" Then
        oInd = oInd + 1
        StarOut.Cells(oInd, 1) = CDate(oArr(i, 1))
        StarOut.Cells(oInd, 2) = oArr(i, 2)
    End If
Next i
'Format:
StarOut.Range("A1:B1").Copy
StarOut.Resize(oInd, 2).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
End Sub


Prova...

[raimea]

ciao

tutto ok

ora tutti i contori , e le altre cosettine che mi servono
su questa nuova tabella, sono in grado di gestirle in autonomia.

grazie

[raimea]

ciao

sarebbe possibile ampliare la macro rip ?

mi sono accorto che per ogni giornata
oltre all' importo giornaliero , gia calcolato correttamente con riep,
mi servirebbe sapere anche
quante puntate sono state fatte nello stesso giorno,
quante V e quante P

quindi, analizzando sempre il fgl generale
vorrei riportare in fgl squadre col AI7:AI
il num. di puntate che sono state fatte

e poi in Aj7;AJ le V
e in AK7:AK le P

vi allego il file

https://www.dropbox.com/scl/fi/98vz9uh5490daktrk6pdu/resa-giornaliera.xlsm?dl=0&rlkey=jz9ww8ycqkffwmz9fxzu93y1c

grazie

ciao

[Anthony47]

Ritoccando qua e là:

Codice: Seleziona tutto

Sub RiepZZ()
Dim StarD As Range, StarW As Range, StarOut As Range
Dim oArr(), lunDat As Long, oInd As Long, i As Long
Dim MinDa As Long, MaxDa As Long
'
'Definizioni:
Set StarD = Sheets("dalambert").Range("B6")
Set StarW = Sheets("dalambert").Range("W6")
Set StarOut = Sheets("Squadre").Range("AG7")
'
lunDat = StarD.Offset(10000, 0).End(xlUp).Row - StarD.Row + 1
MinDa = Application.WorksheetFunction.Min(StarD.Resize(lunDat, 1))
MaxDa = Application.WorksheetFunction.Max(StarD.Resize(lunDat, 1))
'Raccoglie dati:
ReDim oArr(MinDa To MaxDa, 1 To 5)
For i = 1 To lunDat
    If IsDate(StarD.Cells(i, 1)) Then
        oArr(StarD.Cells(i, 1), 1) = StarD.Cells(i, 1)
        oArr(StarD.Cells(i, 1), 2) = oArr(StarD.Cells(i, 1), 2) + StarW.Cells(i, 1)
        oArr(StarD.Cells(i, 1), 3) = oArr(StarD.Cells(i, 1), 3) + 1
        If StarW.Cells(i, -5) = "Vinto" Then
            oArr(StarD.Cells(i, 1), 4) = oArr(StarD.Cells(i, 1), 4) + 1
        Else
            oArr(StarD.Cells(i, 1), 5) = oArr(StarD.Cells(i, 1), 5) + 1
        End If
    End If
Next i
'Scrivi risultati:
StarOut.Offset(1, 0).Resize(lunDat, 5).Clear
For i = LBound(oArr) To UBound(oArr)
    If oArr(i, 1) <> "" Then
        oInd = oInd + 1
        For j = 1 To 5
            If j = 1 Then
                StarOut.Cells(oInd, 1) = CDate(oArr(i, 1))
            Else
                StarOut.Cells(oInd, j) = oArr(i, j)
            End If
        Next j
    End If
Next i
'Format:
StarOut.Range("A1:E1").Copy
StarOut.Resize(oInd, 5).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
End Sub


I risultati sembrano verosimili...

[raimea]

ciao

tutto ok

ancora grazie mille

ciao

[raimea]

ciao
sempre in riferimento a macro resa_giorno in modulo 5
la macro gia funziona correttamente
in relazione alle 2 richieste precedenti.

sono a chiedere se potrebbe essere amplita
andando a compilare un ulteriore colonna in fgl tabelle.

in fgl tabelle col AL7:AL
vorrei riportare anche il valore della cassa all' ultima puntata dello stesso giorno
che si trova in fgl dalambert.



in fgl daslambert col T6:T
vorrei estrapolare il volore della cassa riferito all'ultima puntata
della giornata.

i 3 valori scritti ora in fgl tabelle li ho messi manualmente, x avere un riferimento

mi rendo conto che e' la 3za richiesta di ampliamento su stessa macro,
pertanto se la richiesta richieda uno stravolgimento dell attuale codice
la macro la tengo come e' ora.

via allego il file
https://www.dropbox.com/scl/fi/c5652e9rqxc288qfzrjpx/cassa-finale.xlsm?dl=0&rlkey=zbie4alsqjvboykeau2eunven

grazie

ciao

[Anthony47]

Ri-ritoccando qua e là:

Codice: Seleziona tutto

Sub Resa_giorno()
Dim StarD As Range, StarW As Range, StarOut As Range
Dim OArr(), lunDat As Long, oInd As Long, i As Long
Dim MinDa As Long, MaxDa As Long
'--------------------------------------
'  febbraio 23    da pc-facile by antony
'  serve fare la resa giornaliera
'  http://www.pc-facile.com/forum/viewtopic.php?f=26&t=112821&p=663242#p663242
'-----------------------------------
inizio = Timer
UserForm1.Show vbModeless
DoEvents
''Application.ScreenUpdating = False  'blocca sfarfallio e non vedo cambiare fgl
'Definizioni:
Set StarD = Sheets("dalambert").Range("B6")
Set StarW = Sheets("dalambert").Range("W6")
Set StarOut = Sheets("tabelle").Range("AG7")
'
lunDat = StarD.Offset(10000, 0).End(xlUp).Row - StarD.Row + 1
MinDa = Application.WorksheetFunction.Min(StarD.Resize(lunDat, 1))
MaxDa = Application.WorksheetFunction.Max(StarD.Resize(lunDat, 1))
'Raccoglie dati:
ReDim OArr(MinDa To MaxDa, 1 To 6)
Dim cData As Long, cCassa As Single
For i = 1 To lunDat
    If IsDate(StarD.Cells(i, 1)) Then
        cCassa = StarW.Cells(i, -2)
        cData = Int(StarD.Cells(i, 1).Value)
        If Int(StarD.Cells(i, 1).Value) <> oData Then
            If i > 1 Then OArr(oData, 6) = StarW.Cells(i - 1, -2)
            oData = cData
        End If
        OArr(StarD.Cells(i, 1), 1) = StarD.Cells(i, 1)
        OArr(StarD.Cells(i, 1), 2) = OArr(StarD.Cells(i, 1), 2) + StarW.Cells(i, 1)
        OArr(StarD.Cells(i, 1), 3) = OArr(StarD.Cells(i, 1), 3) + 1
        If StarW.Cells(i, -5) = "Vinto" Then
            OArr(StarD.Cells(i, 1), 4) = OArr(StarD.Cells(i, 1), 4) + 1
        Else
            OArr(StarD.Cells(i, 1), 5) = OArr(StarD.Cells(i, 1), 5) + 1
        End If
    End If
Next i
If i > 1 And cData > 0 Then
    OArr(oData, 6) = cCassa
End If
'Scrivi risultati:
StarOut.Offset(1, 0).Resize(lunDat, 6).Clear
For i = LBound(OArr) To UBound(OArr)
    If OArr(i, 1) <> "" Then
        oInd = oInd + 1
        For J = 1 To 6
            If J = 1 Then
                StarOut.Cells(oInd, 1) = CDate(OArr(i, 1))
            Else
                StarOut.Cells(oInd, J) = OArr(i, J)
            End If
        Next J
    End If
Next i
'Format:
StarOut.Range("A1:F1").Copy
StarOut.Resize(oInd, 6).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
'----- sistemo metto  griglia----------------------
    Range("AG7:AK5000").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlDash
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlDouble
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlDash
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
   
    '-------coloro riga si no --------------------------------
   
      For Z = 7 To Cells(Rows.Count, "AG").End(xlUp).Row  ' 7 1ma riga
   
    Range("AG7:AK1000").Interior.ColorIndex = 2  '<<< sfondo bianco
    Range("AG7:AK1000").Font.Bold = False
    Next Z
   
    For RR = 7 To Z Step 2
       Range("AG" & RR & ":AK" & RR).Interior.ColorIndex = 36
       Range("AG" & RR & ":AK" & 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")
   
End Sub


(incluso le parti dove io non c'entro)
Attenzione: e' necessario che l'elenco in "dalambert" sia ordinato per data; se non e' possibile dobbiamo rivedere

[raimea]

ciao

tutto ok

in fgl dalambert le date sono già ordinate in ord. crescente.

grazie

[raimea]

ciao
sto ricostruendo un file che mi si e' " guastato ! "

dovrei ripristinare la macro >> resa_giorno (Mod 2)

la quale deve compilare fgl tabelle da col AG7:AL

fino alla col AI sono riuscito a farla funzionare
poi x le col Aj:Al no

analizzando il fgl generale col K8 vorrei contare
per lo stesso giorno quante partite ho vinta / persa
e riportarlo in col Aj:AK di fgl tabelle

poi anal. fgl generale col P8 vorrei sommare
per lo stesso giorno la resa giornaliera
e riportarlo in col AL8 di fgl tabelle

vi allego il file

https://www.dropbox.com/scl/fi/h95wkcg9kixhk1pktjnuo/resa_giorno.xlsm?rlkey=v5ac5ul4r5yhqxlepsc8mketb&st=qqn91j0e&dl=0

ciao

[Anthony47]

In questa istruzione c'e' -5 ma deve essere -4:

Codice: Seleziona tutto

        If StarW.Cells(i, -4) = "Vinta" Then


[raimea]

ciao
ok
con questa modifica si sono sistemate le colonne AJ:AK fgl Tabelle

Codice: Seleziona tutto

 If StarW.Cells(i, -4) = "Vinta" Then

rimane da sistemare la col AL di fgl tabelle
dove deve esserci la resa giornaliera calcolata
dal fgl generale Col P8:P

ciao

[raimea]

ciao
mi sono spiegato male
riguardo al contenuto di Col AL di fgl tabelle

la colonna AL7:Al
deve riportare il valore della nuova cassa
che si trova in fgl generale col Q

oppure
si ottiene partendo dalla cassa iniz cella N6 fgl generale
e poi sommando i relativi gain giornalieri di col AH fgl tabelle

ciao

[Anthony47]

Allora...
Non so (non ricordo?) il perchè di alcuni passi della macro; ho rivisto tutta la parte che raccoglie i dati prima di scriverli inserendo anche la correzione per la colonna AL.
Il nuovo pezzo di codice:

Codice: Seleziona tutto

'Raccoglie dati:
ReDim oArr(MinDa To MaxDa, 1 To 6)
Dim cData As Long, cCassa As Single
For i = 1 To lunDat
    If IsDate(StarD.Cells(i, 1)) Then
'        cCassa = StarW.Cells(i, -2)
        cData = Int(StarD.Cells(i, 1).Value)
'        If Int(StarD.Cells(i, 1).Value) <> oData Then
'            If i > 1 Then oArr(oData, 6) = StarW.Cells(i - 1, -2)
'            oData = cData
'        End If
        If cData > 0 Then
            oArr(cData, 6) = StarW.Cells(i, 2)
            oArr(cData, 1) = StarD.Cells(i, 1)
            oArr(cData, 2) = oArr(StarD.Cells(i, 1), 2) + StarW.Cells(i, 1)
            oArr(cData, 3) = oArr(StarD.Cells(i, 1), 3) + 1
            If StarW.Cells(i, -4) = "Vinta" Then
                oArr(cData, 4) = oArr(cData, 4) + 1
            Else
                oArr(cData, 5) = oArr(cData, 5) + 1
            End If
        End If
    End If
Next i
'If i > 1 And cData > 0 Then
'    oArr(oData, 6) = cCassa
'End If
'Scrivi risultati:


Ho lasciato, ma "commentato", il codice eliminato per evidenziare le aree di intervento (le righe possono essere eliminate definitivamente); le altre righe sono in gran parte modificate

[raimea]

ciao
e' tutto ok

grazie