Condividi:        

resa giornaliera

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

resa giornaliera

Postdi raimea » 10/02/23 17:33

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
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1432
Iscritto il: 11/02/10 07:33
Località: lago

Sponsor
 

Re: resa giornaliera

Postdi Marius44 » 10/02/23 19:35

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
Marius44
Utente Senior
 
Post: 658
Iscritto il: 07/09/15 22:00

Re: resa giornaliera

Postdi raimea » 11/02/23 05:30

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
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1432
Iscritto il: 11/02/10 07:33
Località: lago

Re: resa giornaliera

Postdi Anthony47 » 11/02/23 10:54

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...
Avatar utente
Anthony47
Moderatore
 
Post: 19456
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: resa giornaliera

Postdi raimea » 11/02/23 11:21

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
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1432
Iscritto il: 11/02/10 07:33
Località: lago

Re: resa giornaliera

Postdi raimea » 25/02/23 22:43

ciao

sarebbe possibile ampliare la macro rip ? :oops:

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
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1432
Iscritto il: 11/02/10 07:33
Località: lago

Re: resa giornaliera

Postdi Anthony47 » 26/02/23 19:23

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...
Avatar utente
Anthony47
Moderatore
 
Post: 19456
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: resa giornaliera

Postdi raimea » 26/02/23 19:50

ciao

tutto ok

ancora grazie mille

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

Re: resa giornaliera

Postdi raimea » 02/03/23 15:18

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. :oops:

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.

Immagine

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
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1432
Iscritto il: 11/02/10 07:33
Località: lago

Re: resa giornaliera

Postdi Anthony47 » 02/03/23 19:15

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
Avatar utente
Anthony47
Moderatore
 
Post: 19456
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: resa giornaliera

Postdi raimea » 02/03/23 19:38

ciao

tutto ok

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

grazie
Avatar utente
raimea
Utente Senior
 
Post: 1432
Iscritto il: 11/02/10 07:33
Località: lago

Re: resa giornaliera

Postdi raimea » 03/10/24 08:04

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
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1432
Iscritto il: 11/02/10 07:33
Località: lago

Re: resa giornaliera

Postdi Anthony47 » 03/10/24 10:11

In questa istruzione c'e' -5 ma deve essere -4:
Codice: Seleziona tutto
        If StarW.Cells(i, -4) = "Vinta" Then
Avatar utente
Anthony47
Moderatore
 
Post: 19456
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: resa giornaliera

Postdi raimea » 03/10/24 19:15

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
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1432
Iscritto il: 11/02/10 07:33
Località: lago

Re: resa giornaliera

Postdi raimea » 04/10/24 19:20

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

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
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1432
Iscritto il: 11/02/10 07:33
Località: lago

Re: resa giornaliera

Postdi Anthony47 » 05/10/24 12:06

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
Avatar utente
Anthony47
Moderatore
 
Post: 19456
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: resa giornaliera

Postdi raimea » 05/10/24 12:20

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


Torna a Applicazioni Office Windows


Topic correlati a "resa giornaliera":

Newsletter giornaliera?
Autore: webmaster
Forum: Discussioni
Risposte: 30

Chi c’è in linea

Visitano il forum: Nessuno e 29 ospiti