Condividi:        

Conteggio presenze in squadra

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

Conteggio presenze in squadra

Postdi T.Life » 03/07/13 22:02

Salve a tutti,
per motivi di organizzazione lavorativa ho in Excel 2010 un foglio che in” A1:A52” sono elencati i nomi di ogni operaio i quali svolgono turni di lavoro a squadre ( A rotazione )di sei persone. Nella colonna “C” tutte le date dei turni svolti da ogni squadra mentre in” E1 j421” tutte le squadre con i nomi che la componeva. Vi chiedo se è possibile ( tramite una macro) sapere, per ogni operaio, quante volte sia stato in squadra con ogni collega.

https://rapidshare.com/files/456827152/ ... 7EA94D85A;
T.Life
Utente Junior
 
Post: 36
Iscritto il: 22/09/12 13:44

Sponsor
 

Re: Conteggio presenze in squadra

Postdi Anthony47 » 04/07/13 01:53

Allora...
In Foglio2 (o altro foglio a piacere), copia da A2 verso il basso l' elenco dei nominativi; idem da B1 verso destra (puoi copiare l' elenco creato in colonna A e poi fare Incolla speciale /Valori + Trasponi).
Sono le "Intestazioni" della tabella da compilare.
Copia poi in un Modulo standard del vba (es Modulo1) la seguente macro:
Codice: Seleziona tutto
Sub CrossInd()
'
Dim TopRow As String, ShList As String, ShCross As String
Dim I As Long, LastR As Long, J As Long, K As Long, L As Long, myVARR
Dim myX As String, myY As String, myXVal As Long, myYVal As Long
'
ShList = "Foglio1"      '<< Il foglio con le squadre
TopRow = "F1:K1"        '<< La prima riga dell' elenco squadre
ShCross = "Foglio2"     '<< Il foglio dove sara' preparato il cross-index
'
Sheets(ShCross).Cells(2, 2).Resize(Rows.Count - 2, Columns.Count - 2).ClearContents
LastR = Sheets(ShList).Range(TopRow).Range("A1").End(xlDown).Row
myVARR = Sheets(ShList).Range(TopRow).Resize(LastR).Value
For J = 2 To Sheets(ShCross).Range("B1").End(xlToRight).Column
    For K = 2 To Sheets(ShCross).Range("A2").End(xlDown).Row
        myX = Sheets(ShCross).Cells(1, J)
        myY = Sheets(ShCross).Cells(K, 1)
        For I = 0 To LastR - 1
             myXVal = 0: myYVal = 0
            If myX <> myY Then
                For L = 0 To Range(TopRow).Columns.Count - 1
                    If myVARR(LBound(myVARR, 1) + I, LBound(myVARR, 2) + L) = myX Then myXVal = 1
                    If myVARR(LBound(myVARR, 1) + I, LBound(myVARR, 2) + L) = myY Then myYVal = 1
                Next L
                If (myXVal * myYVal) > 0 Then
                    Sheets(ShCross).Cells(J, K).Value = Sheets(ShCross).Cells(J, K).Value + 1
                End If
            End If
        Next I
    Next K
Next J
End Sub

Personalizza le istruzioni marcate << e poi manda in esecuzione la macro; controlla il risultato su foglio impostato in "ShCross" (attenzione, prima della ri-compilazione l' area dati in "ShCross" sara' azzerata senza nessun preavviso, quindi...)

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

Re: Conteggio presenze in squadra

Postdi T.Life » 04/07/13 05:16

Si ero quello che cercavo, ma mi restituisce un risultato incompleto.
http://rapidshare.com/files/456827152/P ... forum.xlsx
T.Life
Utente Junior
 
Post: 36
Iscritto il: 22/09/12 13:44

Re: Conteggio presenze in squadra

Postdi Anthony47 » 04/07/13 08:12

Ho gia' visto quel file.
Mi fai vedere come hai applicato il suggerimento e mi fai un esempio di risultato incompleto?

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

Re: Conteggio presenze in squadra

Postdi T.Life » 04/07/13 12:18

Si scusa, prima avevo postato il file sbagliato

http://rapidshare.com/files/1554105326/ ... forum.xlsm
T.Life
Utente Junior
 
Post: 36
Iscritto il: 22/09/12 13:44

Re: Conteggio presenze in squadra

Postdi Anthony47 » 04/07/13 13:17

??
Alludi al fatto che, ad esempio, non c' e' nessun conteggio per Achille /Adam, Achille /Adriano e tanti altri? Allora e' perche' quelle coppie non esistono...
Se alludi ad altro allora dovresti precisare.

Ricorda che nel tuo elenco "molti" nomi sono seguiti da un "spazio": questo potrebbe incasinare se le intestazioni su Foglio2 non sono esattamente uguali ai nomi che compaiono nelle squadre (ma nel caso dei calcoli fatti questo non e' un problema, perche' le intestazioni hanno/non hanno lo spazio come i nomi in tabella "squadre").

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

Re: Conteggio presenze in squadra

Postdi T.Life » 04/07/13 19:01

Avevi ragione, funziona tutto perfettamente. Sono io che sono un pivello !
Grazie per l'interessamento. Saluti
T.Life
Utente Junior
 
Post: 36
Iscritto il: 22/09/12 13:44

Re: Conteggio presenze in squadra

Postdi T.Life » 11/07/13 14:05

Dovrei creare affianco all’area compilata ( dalla macro ) un’altra tabella, ma ogni volta che aggiorno l’area, cancella tutto quello che si trova sul resto del foglio . Come posso fare per contenere la cancellazione solo all’area interessata ?
T.Life
Utente Junior
 
Post: 36
Iscritto il: 22/09/12 13:44

Re: Conteggio presenze in squadra

Postdi Flash30005 » 11/07/13 14:27

La riga-comando che cancella l'intero range è questa
Codice: Seleziona tutto
Sheets(ShCross).Cells(2, 2).Resize(Rows.Count - 2, Columns.Count - 2).ClearContents


prova a sostituirla e adattarla alla tue esigenze inserndo al suo posto questo codice
Codice: Seleziona tutto
Sheets(ShCross).Range("B2:L1000").ClearContents

(questa ripulisce il range da B2 a L1000)

ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Conteggio presenze in squadra

Postdi T.Life » 12/07/13 04:49

Perfetto Grazie !!!
T.Life
Utente Junior
 
Post: 36
Iscritto il: 22/09/12 13:44

Re: Conteggio presenze in squadra

Postdi Pass96 » 14/07/13 19:21

Ciao a tutti !!! Mi sono appena iscritto e sono felice di far parte di questo forum
Volevo chiedervi quali sono i valori da cambiare per creare la tabella anziché Foglio2 A2 - B1 esempio in Foglio2 M2 - N1
Pass96
Newbie
 
Post: 3
Iscritto il: 14/07/13 18:47

Re: Conteggio presenze in squadra

Postdi Anthony47 » 14/07/13 23:22

Ciao Pass96, benvenuto nel forum.
Credo che basti modificare le linee marcate **
Codice: Seleziona tutto
Sheets(ShCross).Cells(2, 14).Resize(Rows.Count - 2, Columns.Count - 15).ClearContents     '**
LastR = Sheets(ShList).Range(TopRow).Range("A1").End(xlDown).Row
myVARR = Sheets(ShList).Range(TopRow).Resize(LastR).Value
For J = 14 To Sheets(ShCross).Range("N1").End(xlToRight).Column     '**
    For K = 2 To Sheets(ShCross).Range("M2").End(xlDown).Row     '**
        myX = Sheets(ShCross).Cells(1, J)
        myY = Sheets(ShCross).Cells(K, 13)        '**

Ciao, fai sapere.
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Conteggio presenze in squadra

Postdi Pass96 » 15/07/13 04:56

Pass96
Newbie
 
Post: 3
Iscritto il: 14/07/13 18:47

Re: Conteggio presenze in squadra

Postdi Flash30005 » 15/07/13 13:03

Prova la macro così modificata

Codice: Seleziona tutto
Sub CrossInd()
'
Dim TopRow As String, ShList As String, ShCross As String
Dim I As Long, LastR As Long, J As Long, K As Long, L As Long, myVARR
Dim myX As String, myY As String, myXVal As Long, myYVal As Long
'
ShList = "Foglio1"      '<< Il foglio con le squadre
TopRow = "F1:K1"        '<< La prima riga dell' elenco squadre
ShCross = "Foglio2"     '<< Il foglio dove sara' preparato il cross-index
'
 Sheets(ShCross).Range("N2:BU61").ClearContents   '**
LastR = Sheets(ShList).Range(TopRow).Range("A1").End(xlDown).Row
myVARR = Sheets(ShList).Range(TopRow).Resize(LastR).Value
For J = 14 To Sheets(ShCross).Range("N1").End(xlToRight).Column     '**
    For K = 2 To Sheets(ShCross).Range("M2").End(xlDown).Row     '**
        myX = Sheets(ShCross).Cells(1, J)
        myY = Sheets(ShCross).Cells(K, 13)        '**

        For I = 0 To LastR - 1
             myXVal = 0: myYVal = 0
            If myX <> myY Then
                For L = 0 To Worksheets(ShList).Range(TopRow).Columns.Count - 1
                    If myVARR(LBound(myVARR, 1) + I, LBound(myVARR, 2) + L) = myX Then myXVal = 1
                    If myVARR(LBound(myVARR, 1) + I, LBound(myVARR, 2) + L) = myY Then myYVal = 1
                Next L
                If (myXVal * myYVal) > 0 Then
                    Sheets(ShCross).Cells(K, J).Value = Sheets(ShCross).Cells(K, J).Value + 1
                End If
            End If
        Next I
    Next K
Next J
End Sub


ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Conteggio presenze in squadra

Postdi Anthony47 » 15/07/13 14:06

Confermo la correzione di Flash sulla linea
Codice: Seleziona tutto
Sheets(ShCross).Cells(K, J).Value = Sheets(ShCross).Cells(K, J).Value + 1

Infatti nella versione originale J e K erano intercambiabili (perche' valori simmetrici); avendo spostato l' asse X sulla N=14 ed essendo invece rimasto l' asse Y sulla riga 2 i valori J e K non sono piu' intercambiabili e la loro posizione deve essere rigidamente associata all' asse di competenza (come ha fatto Flash).

Ciao a tutti.
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea


Torna a Applicazioni Office Windows


Topic correlati a "Conteggio presenze in squadra":


Chi c’è in linea

Visitano il forum: Nessuno e 55 ospiti