file riepilogativo ore dipendenti

Question

Buongiorno,

ho disperato bisogno del vostro aiuto. 

ho un file excel con 33 fogli; i primi 31 sono dei rapportini dove devo inserire nome e cognome dei dipendenti con il numero di ore ordinarie e straordinarie.  il foglio di riepilogo ORE invece deve contenere l'elenco di tutti i nomi e cognomi (quindi un riepilogo di tutti i valori trovati nei 31 fogli precedenti) in modo da creare un calendario come quello in figura gestibile con le formule "somma.se" ; il foglio riepilogo commesse invece deve essere analogo solo che giorno per giorno mi dice quante ore ordinarie e straordinarie sono state fatte su tutte le commesse che sono state inserite via via nei 31 fogli precedenti. chiedo il vs aiuto perchè i calendari me li riesco a gestire con la formula "somma.se" , ma non riesco in nessun modo (ho provato a copiare ed adattare le macro che gli utenti avevo postato in altre discussioni) a far si che, in un foglio i nominativi, e nell'altro foglio gli id-commessa, vengano riepilogati correttamente. VI PREGO, AIUTATEMI :) 

Answer 1

Ciao Giuseppe,

Purtroppo non sono (completamente) omnisciente! :-) Quindi, non avevo previsto la possibilità che tu avresti voluto cancallare  tutti i dati nei tutti i 31 fogli. Pertanto, quando tu cancella i dati nel trentunnesimo foglio, avendo prima cancellato tutti dati negli altri 30 fogli interessati, riscontri l'errore riportata da te. Per la tua informazione, l'errore viene riscontrato perchè la routine SortedList non può ordinare un elenco vuoto.

Per affrrontare e superare questa possibiltà precedentemente imprevista da me, sostituisci tutto il codice nel ruo modulo standard con la seguente versione nella quale le modifiche sono evidenziate in grassetto:

'=========>>

Option Explicit

Public Const sFoglioRepielogoOre As String = "Rpg ORE"

Public Const sFoglioRepielogoCommesse As String = "Rpg CMS"

Public Const iPrimaRigaDati As Long = 12

'--------->>

Public Sub Tester(aSH As Worksheet, iCol As Long, destSH As Worksheet)

    Dim WB As Workbook

    Dim oSH As Worksheet

    Dim srcRng As Range, destRng As Range, rCell As Range

    Dim arrIn As Variant, arrKeys As Variant

    Dim oDic As Object

    Dim aStr As String

    Dim i As Long

    Dim iRow As Long, jRow As Long, LRow As Long

    Dim CalcMode As Long

    '

    Set WB = ThisWorkbook

    Set oDic = CreateObject("Scripting.Dictionary")

    oDic.CompareMode = 1   '\ TextCompare

    For Each oSH In WB.Worksheets

        If oSH.Name Like "##" Then

            Debug.Print oSH.Name

            Set srcRng = Nothing

            With oSH

                iRow = LastRow(oSH, .Columns(iCol))

                If iRow >= iPrimaRigaDati Then

                    Set srcRng = .Cells(iPrimaRigaDati, iCol). _

                                 Resize(iRow - iPrimaRigaDati + 1)

                End If

            End With

            If Not srcRng Is Nothing Then

                arrIn = srcRng.Value

                If IsArray(arrIn) Then

                    For i = LBound(arrIn) To UBound(arrIn)

                        aStr = arrIn(i, 1)

                        With oDic

                            If Not .exists(aStr) Then

                                .Add Key:=aStr, Item:=vbNullString

                            End If

                        End With

                    Next i

                Else

                    aStr = arrIn

                    With oDic

                        If Not .exists(aStr) Then

                            .Add Key:=aStr, Item:=vbNullString

                        End If

                    End With

                End If

            End If

        End If

    Next oSH

    With destSH

        jRow = LastRow(destSH, .Columns("A:A"))

        If jRow > 2 Then

            Set destRng = .Range("A3:A" & jRow)

        Else

            Set destRng = .Range("A3")

        End If

    End With

    On Error GoTo XIT

    With Application

        CalcMode = .Calculation

        .Calculation = xlCalculationManual

        .EnableEvents = False

        .ScreenUpdating = False

    End With

If oDic.Count = 0 Then

destRng.ClearContents

GoTo XIT

End If

    arrKeys = SortedList(oDic.keys)

    With destRng

        .ClearContents

        .Resize(UBound(arrKeys)).Value = _

        Application.Transpose(arrKeys)

    End With

XIT:

    Set oDic = Nothing

    With Application

        .Calculation = CalcMode

        .EnableEvents = True

        .ScreenUpdating = True

    End With

End Sub

'--------->>

Public Function SortedList(V As Variant)

    Dim oSortedList As Object

    Dim arrOut() As Variant

    Dim sStr As String

    Dim i As Long

    Set oSortedList = CreateObject("System.Collections.Sortedlist")

    With oSortedList

        For i = LBound(V) To UBound(V)

            sStr = V(i)    ', 1)

            If Not sStr = vbNullString Then

                If Not .ContainsKey(sStr) Then

                    .Add Key:=sStr, Value:=i

                End If

            End If

        Next i

        ReDim arrOut(1 To .Count)

        For i = 0 To .Count - 1

            arrOut(i + 1) = .GetKey(i)

        Next i

    End With

    SortedList = arrOut

End Function

'--------->>

Public Function LastRow(SH As Worksheet, _

                        Optional Rng As Range, _

                        Optional minRow As Long = 1)

    If Rng Is Nothing Then

        Set Rng = SH.Cells

    End If

    On Error Resume Next

    LastRow = Rng.Find(What:="*", _

                       after:=Rng.Cells(1), _

                       Lookat:=xlPart, _

                       LookIn:=xlFormulas, _

                       SearchOrder:=xlByRows, _

                       SearchDirection:=xlPrevious, _

                       MatchCase:=False).Row

    On Error GoTo 0

    If LastRow < minRow Then

        LastRow = minRow

    End If

End Function

'<<=========

===

Regards,

Norman

Answer 2

Ciao Giuseppe,

grazie mille per l'aiuto. quando però dal tuo file cancello i nomi dei dipendenti mi escono degli errori di debug che fanno si che la formula non si aggiorni più....

Eppure, a me, no! Per provarlo, ho preso in considerazione le venti righe di dati sul primo foglio, foglio 01:

Ho cancellato tutti questi dati, senza riscontrare alcun errore e il foglio riepilogo  è stato aggiornato nel modo anticipato.

per l'utilizzo a cui è destinato mi potrebbe andar bene anche se i dati non si aggiornano in tempo reale, magari si potrebbe lanciare la macro con dei tasti di scelta rapida, ma il problema fondamentale non è questo, tanto quello che cancellando i nomi da te inseriti si generano degli errori. forse questo può dipendere dal fatto che se apro il codice con alt+f11 non c'è una reale corrispondenza tra l'ordine dei fogli della cartella ed i nomi (ad esempio il foglio 06 viene visto come il riepilogativo, che invece dovrebbe essere foglio 32?) 

In primo luogo, e come spiegato nella mia risposta precedente, il codice nel modulo1 viene eseguita automaticamente in risposta ad una modifica dei dati interessati sui i fogli 01-31.

In secondo luogo, credo che tu stia confondendo il nomi dei fogli con i loro nome codici. Sono cose diverse e, per gli scopi del codice, ho utilizzato solo i nomi dei fogli, cioe; O1, O2 O3... O31.

Pertanto, al fine di permettermi di replicare i tuoi errori, ti chiederei gentilmente di precisare quanto segue: 

• Quali sono i dati che cancellati da te?
• Su quale foglio stai cancellando questi dati?
• Qual è il numero di errore che incontri?
• Qual è il messaggio di errore esatto?
• Quale riga di codice viene evidenziata in giallo
• In quale modulo di codice è la riga evidenziata?

===

Regards,

Norman

Answer 3

Ciao Norman,

grazie mille per l'aiuto. quando però dal tuo file cancello i nomi dei dipendenti mi escono degli errori di debug che fanno si che la formula non si aggiorni più....

per l'utilizzo a cui è destinato mi potrebbe andar bene anche se i dati non si aggiornano in tempo reale, magari si potrebbe lanciare la macro con dei tasti di scelta rapida, ma il problema fondamentale non è questo, tanto quello che cancellando i nomi da te inseriti si generano degli errori. forse questo può dipendere dal fatto che se apro il codice con alt+f11 non c'è una reale corrispondenza tra l'ordine dei fogli della cartella ed i nomi (ad esempio il foglio 06 viene visto come il riepilogativo, che invece dovrebbe essere foglio 32?) 

spero di essermi spiegato, non sono molto pratico

Answer 4

Ciao Giuseppe,

ho disperato bisogno del vostro aiuto. 

ho un file excel con 33 fogli; i primi 31 sono dei rapportini dove devo inserire nome e cognome dei dipendenti con il numero di ore ordinarie e straordinarie.  il foglio di riepilogo ORE invece deve contenere l'elenco di tutti i nomi e cognomi (quindi un riepilogo di tutti i valori trovati nei 31 fogli precedenti) in modo da creare un calendario come quello in figura gestibile con le formule "somma.se" ; il foglio riepilogo commesse invece deve essere analogo solo che giorno per giorno mi dice quante ore ordinarie e straordinarie sono state fatte su tutte le commesse che sono state inserite via via nei 31 fogli precedenti. chiedo il vs aiuto perchè i calendari me li riesco a gestire con la formula "somma.se" , ma non riesco in nessun modo (ho provato a copiare ed adattare le macro che gli utenti avevo postato in altre discussioni) a far si che, in un foglio i nominativi, e nell'altro foglio gli id-commessa, vengano riepilogati correttamente. VI PREGO, AIUTATEMI :) 

Nel modulo di codice del oggetto ThisWorkbook (Questa_cartella_di_lavoro), sositiuisci il codice esistente con la seguente routine d'evento:

'=========>>

Option Explicit

'--------->>

Private Sub Workbook_SheetChange( _

        ByVal SH As Object, _

        ByVal Target As Range)

    Dim oSH As Worksheet, destSH As Worksheet

    Dim RngNomi As Range, RngCommesse As Range

    Dim sStr As String

    Dim iRow As Long, jRow As Long, kRow As Long

    Dim iRows As Long

    Dim CalcMode As Long

    sStr = SH.Name

    If Not sStr Like "##" Then

        Exit Sub

    End If

    If Target.Row < iPrimaRigaDati Then

        Exit Sub

    End If

    With SH

        iRows = .UsedRange.Rows.Count - iPrimaRigaDati + 1

        On Error Resume Next

        Set RngNomi = Intersect(.Range("D" & iPrimaRigaDati) _

                                .Resize(iRows), Target)

        Set RngCommesse = Intersect(.Range("C" & iPrimaRigaDati) _

                                    .Resize(iRows), Target)

        On Error GoTo 0

    End With

    If Not RngNomi Is Nothing Then

        Set destSH = Me.Sheets(sFoglioRepielogoOre)

        Call Tester(SH, RngNomi.Column, destSH)

    End If

    If Not RngCommesse Is Nothing Then

        Set destSH = Me.Sheets(sFoglioRepielogoCommesse)

        Call Tester(SH, RngCommesse.Column, destSH)

    End If

End Sub

'<<=========

In un modulo standard, prima di qualsiasi altro codice,  incolla il seguente codice:

'=========>>

Option Explicit

Public Const sFoglioRepielogoOre As String = "Rpg ORE"

Public Const sFoglioRepielogoCommesse As String = "Rpg CMS"

Public Const iPrimaRigaDati As Long = 12

'--------->>

Public Sub Tester(aSH As Worksheet, iCol As Long, destSH As Worksheet)

    Dim WB As Workbook

    Dim oSH As Worksheet

    Dim srcRng As Range, destRng As Range, rCell As Range

    Dim arrIn As Variant, arrKeys As Variant

    Dim oDic As Object

    Dim aStr As String

    Dim i As Long

    Dim iRow As Long, jRow As Long, LRow As Long

    Dim CalcMode As Long

    '

    Set WB = ThisWorkbook

    Set oDic = CreateObject("Scripting.Dictionary")

    oDic.CompareMode = 1   '\ TextCompare

    For Each oSH In WB.Worksheets

        If oSH.Name Like "##" Then

            Debug.Print oSH.Name

            Set srcRng = Nothing

            With oSH

                iRow = LastRow(oSH, .Columns(iCol))

                If iRow >= iPrimaRigaDati Then

                    Set srcRng = .Cells(iPrimaRigaDati, iCol). _

                                 Resize(iRow - iPrimaRigaDati + 1)

                End If

            End With

            If Not srcRng Is Nothing Then

                arrIn = srcRng.Value

                For i = LBound(arrIn) To UBound(arrIn)

                    aStr = arrIn(i, 1)

                    With oDic

                        If Not .exists(aStr) Then

                            .Add Key:=aStr, Item:=vbNullString

                        End If

                    End With

                Next i

            End If

        End If

    Next oSH

    With destSH

        jRow = LastRow(destSH, .Columns("A:A"))

        If jRow > 2 Then

            Set destRng = .Range("A3:A" & jRow)

        Else

            Set destRng = .Range("A3")

        End If

    End With

    arrKeys = SortedList(oDic.keys)

    On Error GoTo XIT

    With Application

        CalcMode = .Calculation

        .Calculation = xlCalculationManual

        .EnableEvents = False

        .ScreenUpdating = False

    End With

    With destRng

        .ClearContents

        .Resize(UBound(arrKeys)).Value = _

        Application.Transpose(arrKeys)

    End With

XIT:

    Set oDic = Nothing

    With Application

        .Calculation = CalcMode

        .EnableEvents = True

        .ScreenUpdating = True

    End With

End Sub

'--------->>

Public Function SortedList(V As Variant)

    Dim oSortedList As Object

    Dim arrOut() As Variant

    Dim sStr As String

    Dim i As Long

    Set oSortedList = CreateObject("System.Collections.Sortedlist")

    With oSortedList

        For i = LBound(V) To UBound(V)

            sStr = V(i)

            If Not sStr = vbNullString Then

                If Not .ContainsKey(sStr) Then

                    .Add Key:=sStr, Value:=i

                End If

            End If

        Next i

        ReDim arrOut(1 To .Count)

        For i = 0 To .Count - 1

            arrOut(i + 1) = .GetKey(i)

        Next i

    End With

    SortedList = arrOut

End Function

'--------->>

Public Function LastRow(SH As Worksheet, _

                        Optional Rng As Range, _

                        Optional minRow As Long = 1)

    If Rng Is Nothing Then

        Set Rng = SH.Cells

    End If

    On Error Resume Next

    LastRow = Rng.Find(What:="*", _

                       after:=Rng.Cells(1), _

                       Lookat:=xlPart, _

                       LookIn:=xlFormulas, _

                       SearchOrder:=xlByRows, _

                       SearchDirection:=xlPrevious, _

                       MatchCase:=False).Row

    On Error GoTo 0

    If LastRow < minRow Then

        LastRow = minRow

    End If

End Function

'<<=========

Ho scaricato il tuo file e, per eseguire le mie prove, ho immesso dei dati sui fogli 01 a 31,

Il codice funziona automaticamente in risposta all'immesso, la modifica o la cancellazione di qualunque dato nelle colonne C:D, e sotto le intestazione nella la riga 11, dei fogli 01-31, per riempire o aggiornare i nomi dei dipendenti e/o le commesse in colonna A dei fogli di riepilogo RPG ORE e  RPG CMS. Nota che i dati nella prima colonna di questi due ultimi fogli vengano ordinati/riordinati, utilizzando la funzione SortedList.

Potresti scaricare il mio file di prova Giuseppe20160213.xlsm a:

https://www.dropbox.com/s/rl9n8k6xm8gxxz1/Giuseppe20160213.xlsm?dl=0

===

Regards,

Norman

Answer 5

allego il file per comodità nel caso in cui qualcuno ci volesse dare un'occhiata. 

https://onedrive.live.com/redir?resid=4307EAE2CFE9E34A!201&authkey=!ANHops8x-GyzHSE&ithint=file%2cxlsm